myoung3

#https://twitter.com/michaeltyoung3/status/1371222727261003782
library(Rmpfr)
matches <- character()
prec <- 1200
while(length(matches)==0L){
  x <- Const("pi",prec = prec)
  xchr <- format(x)
  r <- regexpr("314",xchr)
  matches <- regmatches(xchr, r)
  prec <- prec + 1200

myoung3

#inspired by https://twitter.com/jeremy_data/status/1370865851595943943
#lines 7-33:
 #Allen (2021, March 13). jeremydata: Counts and Cumulative Sums by Group. Retrieved from https://jeremydata.com/posts/2021-03-13-counts-and-cumulative-sums-by-group/
 #changes were made to the sample size (n)
#lines 34-50:
  #Creative Commons Attribution https://creativecommons.org/licenses/by/4.0/, Michael T Young  
library(data.table)
library(lubridate)

#---- fake data ----

myoung3

#x a data.frame
#group_vars a character vector of column names in x
#fun_list a named list of functions. 
#value_vars A character vector of column names in x over which to calculate functions.
  #if NULL every function will be calculated for every non-grouping column
#more_args_list either a list of lists where each sub-list contains arguments to be passed to corresponding function function in fun_list
 #if more_args_list is unnamed, it must be length(fun_list) and elements of more_args_list will be matched to elements of fun_list by position.
 #if named, its length can be less than or equal to length(fun_list). elements of more_args_list  will be matched to elements of fun_list by name
group_across <- function(x,group_vars,fun_list,value_vars=NULL,more_args_list=NULL){
  if(is.null(value_vars)) value_vars <- setdiff(names(x),group_vars)

myoung3

library(lme4)
library(data.table)
library(parallel)
simulate <- function(n,sd_y,sd_id, effect_size=1, nsimulations=1e4,clustersize=40){
  #create lists of length-3. once for each statistical approach.
  #each element has length nsimulations
  seeds <- runif(nsimulations,-2e9,2e9)
  
  cl <- makeCluster(clustersize)
  clusterExport(cl, c("n","sd_id","sd_y","effect_size"),envir = environment())

myoung3

#capture the arguments and return as list
g <- function(X, FUN){
  call <- match.call()
  as.list(call)[-1]
}

x <- replicate(10,rnorm(50),simplify = FALSE)
y1 <- do.call(lapply, g(x, mean, trim=.2)) #do.call the returned arguments into lapply
y2 <- lapply(x,mean, trim=.2) #same as calling directly on lapply

myoung3

require(plyr)
require(ggplot2)


###eapply accepts a function and and a call to expand grid
###where columns created by expand.grid must correspond to arguments of fun
##each row created by expand.grid will be called by fun independently


##fun either a function or a non-empty character string naming the function to be called.

myoung3

require(reshape2)
require(plyr)

f <- url("http://emersonstatistics.com/datasets/bcarot.txt", open = "r")
b <- read.table(f,header=TRUE)
close(f)

b <- transform(b,	
	sex=factor(sex),
	dstart=as.character(dstart),

myoung3

##biost 536, University of Washington
##this code generally corresponds to the stata code in the October 4th lecture
d <- expand.grid(case=0:1, xray=0:1,yob=0:1)
d$freq <- c(2388,2220,241,409,2936,2774,361,523)


##model with no interactions
mylogit <- glm(case~xray + yob, data=d,
	family=binomial(link="logit"),
	weights=d$freq)