danlewer

# function requires data.table

library(data.table)

#------------------------
# exact matching function
#------------------------

# stratifies dataset and then selects random observations within strata
# data = dataset containing:

danlewer

# rescale a numeric vector to new maximum and minimum values
# original values will map to new values in a linear fashion

rescale <- function(x, MIN, MAX) { # linear rescaling
  y <- x - min(x)
  y <- y * (MAX - MIN) / max(y)
  y + MIN
}

# example

danlewer

# function
# 'screen' is numeric vector of scores from the screening tool
# 'gs' is a logical vector showing gold standard disease status
# 'vals' is a numeric vector of screening tool values to test (including all values in 'screen')
# returns a ROC plot and a list where the first value is the sensitivity and specificity for all values of 'val', and the second is the area under ROC

easyRoc <- function(screen, gs, vals) { 
  pos <- screen >= rep(vals, each = length(screen))
  pos <- matrix(pos, ncol = length(vals))
  sens <- colSums(gs & pos) / sum(gs)

danlewer

make_age_group <- function(ages, min_val = seq(10, 100, 10)) {
  x <- findInterval(ages, min_val)
  y <- setNames(as.data.frame.list(aggregate(ages, list(x), range)), c('group', 'min', 'max'))
  y$label <- ifelse(y$min == y$max, y$min, paste0(y$min,'-',y$max))
  return(factor(x, y$group, y$label))
}

danlewer

# function

mbPaired <- function(x, y, B = 1000) {
  lx <- length(x)
  ly <- length(y)
  if (lx != ly) stop('x and y differ in length')
  # sample indices
  M <- sample(seq_len(lx), size = lx * B, replace = T)
  # calculate differences and mean of differences
  diffs <- x[M] - y[M]

danlewer

#-------------
# example data
#-------------

actual <- expand.grid(age = 1:3, sex = c('m', 'f')) # age groups 1:3
actual$n <- c(103, 313, 584, 606, 293, 101)
actual$true_prob <- c(0.1, 0.2, 0.4, 0.15, 0.25, 0.45)

dat <- actual
dat$sample_success <- rbinom(nrow(dat), dat$n, dat$true_prob) # study sample

danlewer

# save your sudoku as a tab delimited text file. Stringr is for the function str_count

library(stringr)
puz <- as.matrix(read.csv("sudpuz.txt", sep="\t", header = F))
y <- c(puz)

# make keys

sq_start <- c(1, 4, 7, 28, 31, 34, 55, 58, 61)
key <- matrix(1:81, 9, 9)