inst/tree_sampling/part-sampling.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

## SKG
##
## March 5, 2020
## Fooling around with a couple of sampling mechanisms


library(RcppAlgos)
library(rpartitions)
library(partitions)



## METHOD A
## GENERATE WHOLE PARTITION SPACE THEN SAMPLE a permutation based on weights
n <- 60
m <- n/2
B <- 100

parts <- partitions::restrictedparts(n = n, m = m, include.zero = FALSE)
dim(parts)

v <- parts[,1]
wt <- RcppAlgos::permuteCount(sort(unique(v)), freqs = table(v))
wts <- apply(parts, 2, function(x){
  if(length(unique(x)) == 1) return(1)
  RcppAlgos::permuteCount(sort(unique(x)), freqs = table(x))
})
length(wts) == ncol(parts)
part_inds <- sample(1:ncol(parts), size = B, replace = TRUE, prob = wts / sum(wts))
part <- parts[, part_ind]
perm <- RcppAlgos::permuteSample(v = sort(unique(part)), freqs = table(part), n = 1)
## So looks like we can sample up to n = 60.


## METHOD B
## Sample a bunch and then hope the central limit theorem works
n <- 100
m <- n/2
B <- 100

parts <-  rpartitions::rand_partitions(Q = n, sample_size = B, N = m)
v <- parts[,1]
wts <- apply(parts, 2, function(x){
  if(length(unique(x)) == 1){
    out <- 1
    return(out)
  }
  out <- RcppAlgos::permuteCount(sort(unique(x)), freqs = table(x))
  if(length(out) > 1) browser()
  return(out)
})
length(wts) == ncol(parts)
part_ind <- sample(1:ncol(parts), size = 1, replace = TRUE, prob = wts / sum(wts))
part <- parts[, part_ind]
perm <- RcppAlgos::permuteSample(v = sort(unique(part)), freqs = table(part), n = 1)