P <- 1000
K <- 200
D <- 130000
N <- 5
payments <- matrix(0, nrow=P, ncol=K)
for (r in 1:P){
  payments[r,] <- rexp(K,N/D)
}
chunk <- function(D,N){
  chunks <- runif(N)
  chunks <- chunks/sum(chunks)
  return( D*chunks )
}
for (r in 1:(P/2)){
    payments[r,1:N] <- chunk(D,N)
}
is.near <- function(x,y,eps){
  if ( abs(x-y) < eps ){
    return(1)
  }
  else{
    return(0)
  }
}
emp.sums <- function(r,N,M){
  ret <- sapply(1:M, function(m){ sum( sample(r,N,replace=TRUE) ) })
  return(ret)
}
strat.1 <- function(r,D,N,M,eps){
  sums <- emp.sums(r,N,M)
  hits <- sum( sapply( sums, function(x) { is.near(x,D,eps) } ) )
  return( hits/M )
}
strat.2 <- function(r,D,N,M){
  sums <- emp.sums(r,N,M)
  exceeds <- sum( sums > D )
  return( exceeds/M )
}
strat.a <- function(r,D,N,M,eps){
  sums <- emp.sums(r,N,M)
  hits <- max( sapply( sums, function(x) { is.near(x,D,eps) } ) )
  return( hits )
}
chunk <- function(D,N){
  chunks <- runif(N)
  chunks <- chunks/sum(chunks)
  return( D*chunks )
}
for (r in 1:(P/2)){
    payments[r,1:N] <- chunk(D,N)
}
M <- 10000
eps <- .72
strat.1.scores <- apply( payments, 1, function(r){ strat.1(r,D,N,M,eps) } )
strat.2.scores <- apply( payments, 1, function(r){ strat.2(r,D,N,M) } )
strat.a.scores <- apply( payments, 1, function(r){ strat.a(r,D,N,M,eps) } )
bogus.rows <- c( rep(1, P/2), rep(0,P/2)  )
print('Percent Correct:')
[1] "Percent Correct:"
sum(strat.a.scores == bogus.rows)/length(strat.a.scores)
[1] 0.499
print('Score Vector:')
[1] "Score Vector:"
strat.a.scores
   [1] 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 0 1
 [120] 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 [239] 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
 [358] 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0
 [477] 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
 [596] 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0
 [715] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0
 [834] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0
 [953] 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
pr.flag.given.fraud <- sum(strat.a.scores[1:(P/2)])/(P/2)
pr.flag <- sum(strat.a.scores)/P
print(pr.flag.given.fraud)
[1] 0.08
print(pr.flag)
[1] 0.081
LS0tCnRpdGxlOiAiVGhlIExhZHkgTWlzYXBwcm9wcmlhdGluZyBDYW1wYWlnbiBGdW5kcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3IsIGVjaG89VFJVRX0KUCA8LSAxMDAwCksgPC0gMjAwCgpEIDwtIDEzMDAwMApOIDwtIDUKCnBheW1lbnRzIDwtIG1hdHJpeCgwLCBucm93PVAsIG5jb2w9SykKZm9yIChyIGluIDE6UCl7CiAgcGF5bWVudHNbcixdIDwtIHJleHAoSyxOL0QpCn0KCmNodW5rIDwtIGZ1bmN0aW9uKEQsTil7CiAgY2h1bmtzIDwtIHJ1bmlmKE4pCiAgY2h1bmtzIDwtIGNodW5rcy9zdW0oY2h1bmtzKQogIHJldHVybiggRCpjaHVua3MgKQp9Cgpmb3IgKHIgaW4gMTooUC8yKSl7CiAgICBwYXltZW50c1tyLDE6Tl0gPC0gY2h1bmsoRCxOKQp9CgoKaXMubmVhciA8LSBmdW5jdGlvbih4LHksZXBzKXsKICBpZiAoIGFicyh4LXkpIDwgZXBzICl7CiAgICByZXR1cm4oMSkKICB9CiAgZWxzZXsKICAgIHJldHVybigwKQogIH0KfQoKZW1wLnN1bXMgPC0gZnVuY3Rpb24ocixOLE0pewogIHJldCA8LSBzYXBwbHkoMTpNLCBmdW5jdGlvbihtKXsgc3VtKCBzYW1wbGUocixOLHJlcGxhY2U9VFJVRSkgKSB9KQogIHJldHVybihyZXQpCn0KCgpzdHJhdC4xIDwtIGZ1bmN0aW9uKHIsRCxOLE0sZXBzKXsKICBzdW1zIDwtIGVtcC5zdW1zKHIsTixNKQogIGhpdHMgPC0gc3VtKCBzYXBwbHkoIHN1bXMsIGZ1bmN0aW9uKHgpIHsgaXMubmVhcih4LEQsZXBzKSB9ICkgKQogIHJldHVybiggaGl0cy9NICkKfQoKc3RyYXQuMiA8LSBmdW5jdGlvbihyLEQsTixNKXsKICBzdW1zIDwtIGVtcC5zdW1zKHIsTixNKQogIGV4Y2VlZHMgPC0gc3VtKCBzdW1zID4gRCApCiAgcmV0dXJuKCBleGNlZWRzL00gKQp9CgpzdHJhdC5hIDwtIGZ1bmN0aW9uKHIsRCxOLE0sZXBzKXsKICBzdW1zIDwtIGVtcC5zdW1zKHIsTixNKQogIGhpdHMgPC0gbWF4KCBzYXBwbHkoIHN1bXMsIGZ1bmN0aW9uKHgpIHsgaXMubmVhcih4LEQsZXBzKSB9ICkgKQogIHJldHVybiggaGl0cyApCn0KCmNodW5rIDwtIGZ1bmN0aW9uKEQsTil7CiAgY2h1bmtzIDwtIHJ1bmlmKE4pCiAgY2h1bmtzIDwtIGNodW5rcy9zdW0oY2h1bmtzKQogIHJldHVybiggRCpjaHVua3MgKQp9Cgpmb3IgKHIgaW4gMTooUC8yKSl7CiAgICBwYXltZW50c1tyLDE6Tl0gPC0gY2h1bmsoRCxOKQp9CgpNIDwtIDEwMDAwCmVwcyA8LSAuNzIKc3RyYXQuMS5zY29yZXMgPC0gYXBwbHkoIHBheW1lbnRzLCAxLCBmdW5jdGlvbihyKXsgc3RyYXQuMShyLEQsTixNLGVwcykgfSApCnN0cmF0LjIuc2NvcmVzIDwtIGFwcGx5KCBwYXltZW50cywgMSwgZnVuY3Rpb24ocil7IHN0cmF0LjIocixELE4sTSkgfSApCnN0cmF0LmEuc2NvcmVzIDwtIGFwcGx5KCBwYXltZW50cywgMSwgZnVuY3Rpb24ocil7IHN0cmF0LmEocixELE4sTSxlcHMpIH0gKQoKYm9ndXMucm93cyA8LSBjKCByZXAoMSwgUC8yKSwgcmVwKDAsUC8yKSAgKQpgYGAKCmBgYHtyfQpwcmludCgnUGVyY2VudCBDb3JyZWN0OicpCnN1bShzdHJhdC5hLnNjb3JlcyA9PSBib2d1cy5yb3dzKS9sZW5ndGgoc3RyYXQuYS5zY29yZXMpCnByaW50KCdTY29yZSBWZWN0b3I6JykKc3RyYXQuYS5zY29yZXMKYGBgCgpgYGB7cn0KcHIuZmxhZy5naXZlbi5mcmF1ZCA8LSBzdW0oc3RyYXQuYS5zY29yZXNbMTooUC8yKV0pLyhQLzIpCnByLmZsYWcgPC0gc3VtKHN0cmF0LmEuc2NvcmVzKS9QCgpwcmludChwci5mbGFnLmdpdmVuLmZyYXVkKQpwcmludChwci5mbGFnKQpgYGAKCg==