diff --git a/boots.lmer/.DS_Store b/boots.lmer/.DS_Store index c787e2c..e5e5879 100644 Binary files a/boots.lmer/.DS_Store and b/boots.lmer/.DS_Store differ diff --git a/boots.lmer/.Rhistory b/boots.lmer/.Rhistory index c9e048a..f78cfb1 100644 --- a/boots.lmer/.Rhistory +++ b/boots.lmer/.Rhistory @@ -1,126 +1,3 @@ -for(i in seq_along(temp)){ -if(temp[i]>1){ #if the subject id appears more than once -num.appearance<-temp[i] #number of times the subject appears in the sample -x[which(x==names(temp)[i])]<-paste0(names(temp)[i],"__",1:num.appearance) #generate new subject ID by concatenating "_#" at the end of the id. Replace the old name with this -} -} -x #return the list of sampled subject ID , now all sample should be unique subject ID. -}) -#now sample the index of subject ID. -# output<- -# apply(no.repeat.id,2,function(x){ -# temp<- -# sapply(x,function(x_i){ #for each subject -# index<-which(sub.id==stringr::word(x_i,1,sep = "\\__")) #index of original data where the subject id appears -# cbind(index, "no.repeat.id"=rep(x_i,length(index)))}) -# -# #If length(sub.id)!=length(unique.id), then temp is a list of length(unique.id). Each list is for each unique id. rbind those list. -# if(is.list(temp)){ -# do.call(rbind, lapply(temp, data.frame)) -# }else{#If length(sub.id)==length(unique.id), temp will be a matrix of ncol=length(unique.id). Transpose it so that the columns are index and no.repeat.id. -# temp<-t(temp) -# colnames(temp)<-c("index","no.repeat.id") -# data.frame(temp) -# } -# -# } -# ) -output<- -apply(no.repeat.id,2,function(x){ -temp<- -sapply(x,function(x_i){ #for each subject -index<-which(sub.id==stringr::word(x_i,1,sep = "\\__")) #index of original data where the subject id appears -cbind(index, "no.repeat.id"=rep(x_i,length(index)))}) -#bind the index and no.repeat.id. as rows -temp.dat<-do.call(rbind, lapply(temp, data.table::data.table)) -complete.dat<-data.table::as.data.table(dat[temp.dat$index,]) -# complete.dat<-complete.dat[,!..sub.id] #remove the original subject ID -complete.dat[,no.repeat.sub.id:=temp.dat$no.repeat.id] # add the new subject ID column, with no repetition -} -) -output -} -output<-boots.samples(dat=example.dat,sub.id = "subjects",B=4) -knitr::kable(output,caption = "Table 2. Four boostrap samples of example.dat data sets. The sampling unit is subject, hence the number of rows of each data set is expected to be different from one another.",row.names = FALSE) -knitr::kable(output[[1]],caption = "Table 2.A. The first bootstrap sample",row.names = FALSE) -devtools::document -devtools::document() -library(boots.lmer) -#' @examples -#' example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") -#' example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), -#' "X1"=rpois(n=length(example.subject), lambda = 3), -#' "X2"=rnorm(n=length(example.subject)), -#' "X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), -#' "subjects"=example.subject) -#' output<-boots.samples(dat=example.dat,sub.id = "subjects",B=4) #create 4 bootstrap samples -#' output[[1]] #This is the first one! -#' @export -boots.samples<-function(dat, sub.id,B){ -library(data.table) -sub.id<-dat[,sub.id] -#collect unique subject ID's -unique.id<-unique(sub.id) -#sample unique subject ID, B number of times -this.index<-sapply(1:B,function(e){sample(unique.id, size = length(unique.id),replace = TRUE)}) -#we need to take a note of people who are sampled more than once to make sure that they are sampled from the data as if they are different individuals. -no.repeat.id<- -apply(this.index,2, function(x){ -temp<-table(x) -for(i in seq_along(temp)){ -if(temp[i]>1){ #if the subject id appears more than once -num.appearance<-temp[i] #number of times the subject appears in the sample -x[which(x==names(temp)[i])]<-paste0(names(temp)[i],"__",1:num.appearance) #generate new subject ID by concatenating "_#" at the end of the id. Replace the old name with this -} -} -x #return the list of sampled subject ID , now all sample should be unique subject ID. -}) -#now sample the index of subject ID. -# output<- -# apply(no.repeat.id,2,function(x){ -# temp<- -# sapply(x,function(x_i){ #for each subject -# index<-which(sub.id==stringr::word(x_i,1,sep = "\\__")) #index of original data where the subject id appears -# cbind(index, "no.repeat.id"=rep(x_i,length(index)))}) -# -# #If length(sub.id)!=length(unique.id), then temp is a list of length(unique.id). Each list is for each unique id. rbind those list. -# if(is.list(temp)){ -# do.call(rbind, lapply(temp, data.frame)) -# }else{#If length(sub.id)==length(unique.id), temp will be a matrix of ncol=length(unique.id). Transpose it so that the columns are index and no.repeat.id. -# temp<-t(temp) -# colnames(temp)<-c("index","no.repeat.id") -# data.frame(temp) -# } -# -# } -# ) -output<- -apply(no.repeat.id,2,function(x){ -temp<- -sapply(x,function(x_i){ #for each subject -index<-which(sub.id==stringr::word(x_i,1,sep = "\\__")) #index of original data where the subject id appears -cbind(index, "no.repeat.id"=rep(x_i,length(index)))}) -#bind the index and no.repeat.id. as rows -temp.dat<-do.call(rbind, lapply(temp, data.table::data.table)) -complete.dat<-data.table::as.data.table(dat[temp.dat$index,]) -# complete.dat<-complete.dat[,!..sub.id] #remove the original subject ID -complete.dat[,no.repeat.sub.id:=temp.dat$no.repeat.id] # add the new subject ID column, with no repetition -} -) -output -} -example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") -example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), -"X1"=rpois(n=length(example.subject), lambda = 3), -"X2"=rnorm(n=length(example.subject)), -"X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), -"subjects"=example.subject) -tt<-boots.samples(dat = example.dat, sub.id = "subjects",B=4) -tt -help(":=") -DT = data.table(a = LETTERS[c(3L,1:3)], b = 4:7) -DT -DT[, c := 8] # add a numeric column, 8 for all rows #' @examples #' example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") #' example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), @@ -510,3 +387,126 @@ lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) lmer.out[5000] lmer.out1<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output[[100]]) library(boots.lmer) +library(boots.lmer) +library(boots.lmer) +output +set.seed(1020) +example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") +example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), +"X1"=rpois(n=length(example.subject), lambda = 3), +"X2"=rnorm(n=length(example.subject)), +"X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), +"subjects"=example.subject) +knitr::kable(example.dat, caption = "Table 1. Example data set.") +output<-boots.samples(dat = example.dat, sub.id = "subjects",B=4) +output +output +??boots.lmer +usethis::use_vignette("vignette") +library(boots.lmer) +library(boots.lmer) +??boots.lmer +install.packages("../boots.lmer_0.0.0.9000.tar.gz") +install.packages("../boots.lmer_0.0.0.9000.tar.gz") +library(boots.lmer) +set.seed(1020) +example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") +example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), +"X1"=rpois(n=length(example.subject), lambda = 3), +"X2"=rnorm(n=length(example.subject)), +"X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), +"subjects"=example.subject) #generate example data +output<-boots.samples(dat=example.dat,sub.id ="subjects",B=4) #a list of 4 bootstrap samples +lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) +lmer.out +lmer.out1<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output[[62]]) +set.seed(1204) +output<-boots.samples(dat=example.dat,sub.id ="subjects",B=5000) +lmer.out1<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output[[62]]) +this.fit<-(lme4::lmer(Y ~ X1 + X2 + X3 + (1 | no.repeat.sub.id), dat=output[[62]],REML=FALSE)) +View(output[[62]]) +this.fit<-(lme4::lmer(Y ~ X1 + X2 + (1 | no.repeat.sub.id), dat=output[[62]],REML=FALSE)) +this.fit +set.seed(1020) +example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") +example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), +"X1"=rpois(n=length(example.subject), lambda = 3), +"X2"=rnorm(n=length(example.subject)), +"X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5)+rnorm(length(exmaple.subject), mean=6), +"subjects"=example.subject) #generate example data +set.seed(1020) +example.subject<-c("Sarah","John","Beth","Anna","Sarah","Sarah","Chris","Blake","John","Anna") +example.dat<-data.frame("Y"=rnorm(n=length(example.subject)), +"X1"=rpois(n=length(example.subject), lambda = 3), +"X2"=rnorm(n=length(example.subject)), +"X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5)+rnorm(length(example.subject), mean=6), +"subjects"=example.subject) #generate example data +output<-boots.samples(dat=example.dat,sub.id ="subjects",B=4) #a list of 4 bootstrap samples +lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) +lmer.out +set.seed(1204) +output<-boots.samples(dat=example.dat,sub.id ="subjects",B=5000) +lmer.out1<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) +summary(lmer.out[[1]]) +coef.out<- +lapply(lmer.out,function(fit){ +if(class(fit)=="lm"){ #If linear model was fit, use below function +coef(lmer.out[[46]]) +}else{ #IF +lme4::fixef(lmer.out[[46]]) +} +}) +coef.out<- +lapply(lmer.out,function(fit){ +if(class(fit)=="lm"){ #If linear model was fit, use below function +coef(fit) +}else{ #IF +lme4::fixef(fit) +} +}) +length(coef.out) +lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) +coef.out<- +lapply(lmer.out,function(fit){ +if(class(fit)=="lm"){ #If linear model was fit, use below function +coef(fit) +}else{ #IF +lme4::fixef(fit) +} +}) +length(coef.out) +coef.out2<-Reduce("rbind",coef.out) +coef.out[[1]] +coef.out[[46]] +class(coef.out[[46]]) +coef.out2<-do.call(rbind,coef.out) +coef.out[[27]] +output[[27]] +lmer.out[[27]] +which(is.na(this.X3)) +#extract coefficient estimate for X3 +this.X3<- +lapply(coef.out,function(x){ +x["X3"] +}) +#Here are all NA's +sum(is.na(this.X3)) +which(is.na(this.X3)) +lmer.out[[27]] +hist(this.X3) +this.X3 +est.X3<-unlist(this.X3) +#extract coefficient estimate for X3 +this.X3<- +lapply(coef.out,function(x){ +x["X3"] +}) +est.X3<-unlist(this.X3) +#Here the number of NA's +sum(is.na(est.X3)) +#index of all whose estimated effect of X3 is NA +which(is.na(est.X3)) +hist(est.X3) +?boots.lmer +install.packages("../boots.lmer_0.0.0.9000.tar.gz") +install.packages("../boots.lmer_0.0.0.9000.tar.gz") diff --git a/boots.lmer/R/boots.lmer.R b/boots.lmer/R/boots.lmer.R index 8f2195e..45e2c8c 100644 --- a/boots.lmer/R/boots.lmer.R +++ b/boots.lmer/R/boots.lmer.R @@ -2,9 +2,10 @@ #' Bootstrap Sampled Linear Mixed Effects Models (LMERs) #' @return A list of length B, of linear mixed effects model fits. -#' @param boots.samples.list boots.samples output. #' @param y character string. Name of column in each data.table of boots.samples.list, to be used as the outcome in LMER. #' @param X a vector of character string. Names of the of covariates to fit in LMER, as they appear on each dataset of boots.samples.list. +#' @param dat a data frame or data table, which contains y, X. Also should contain the subject column which was used to generate boots.samples.list. +#' @param boots.samples.list boots.samples output. #' @param use.formula a vector of class formula. This is to be used in lmer fit. If not provided, then a basic additive fixed effects model with random effect of (1|no.repeat.sub.id) will be fit. #' @param num_workers integer. A number of cores to use for parallel computing. #' @examples @@ -15,9 +16,9 @@ #' "X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), #' "subjects"=example.subject) #' output<-boots.samples(dat=example.dat,sub.id = "subjects",B=4) #create 4 bootstrap samples -#' lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), boots.samples.list = output) +#' lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), dat=example.dat, boots.samples.list = output) #' @export -boots.lmer<-function(y,X,boots.samples.list,use.formula=NULL, num_workers=NULL){ +boots.lmer<-function(y,X,dat,boots.samples.list,use.formula=NULL, num_workers=NULL){ diff --git a/boots.lmer/R/boots.samples.R b/boots.lmer/R/boots.samples.R index 9485a5a..759f350 100644 --- a/boots.lmer/R/boots.samples.R +++ b/boots.lmer/R/boots.samples.R @@ -13,7 +13,7 @@ #' "X3"=rbeta(n=length(example.subject), shape1 = 3, shape2 = 0.5), #' "subjects"=example.subject) #' output<-boots.samples(dat=example.dat,sub.id = "subjects",B=4) #create 4 bootstrap samples -#' output[[1]] #This is the first one! +#' output[[1]] #This is the first sample. A data table with two columns, an index column and the new subject names #' @export boots.samples<-function(dat, sub.id,B){ @@ -45,11 +45,19 @@ boots.samples<-function(dat, sub.id,B){ index<-which(sub.id==stringr::word(x_i,1,sep = "\\__")) #index of original data where the subject id appears cbind(index, "no.repeat.id"=rep(x_i,length(index)))}) #get all observation for this particular subject. + #####Return just index and new naming##### + dat_return<-Reduce("rbind",temp) + dat_return<-data.table::as.data.table(dat_return) + dat_return[,index:=as.numeric(index)] + dat_return + ########################################## - temp.dat<-do.call(rbind, lapply(temp, data.frame)) - complete.dat<-dat[temp.dat$index,] - complete.dat[,"no.repeat.sub.id"]<-temp.dat[,"no.repeat.id"] - return(complete.dat) + ###### return data frame ###### + # temp.dat<-do.call(rbind, lapply(temp, data.frame)) + # complete.dat<-dat[temp.dat$index,] + # complete.dat[,"no.repeat.sub.id"]<-temp.dat[,"no.repeat.id"] + # return(complete.dat) + ########################################## # #bind the index and no.repeat.id. as rows # temp.dat<-do.call(rbind, lapply(temp, data.table::data.table)) diff --git a/boots.lmer/vignettes/create_lmer_fits.Rmd b/boots.lmer/vignettes/create_lmer_fits.Rmd index 43b871b..02736d3 100644 --- a/boots.lmer/vignettes/create_lmer_fits.Rmd +++ b/boots.lmer/vignettes/create_lmer_fits.Rmd @@ -60,7 +60,7 @@ We will generate 5,000 bootstrap samples and fit additive LMER model with random ```{r cache=TRUE} set.seed(1204) -output<-boots.samples(dat=example.dat,sub.id ="subjects",B=5000) +output<-boots.samples(dat=example.dat,sub.id ="subjects",B=100)#change back to 5000 later ``` diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.RData b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.RData new file mode 100644 index 0000000..abced0f Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.RData differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdb b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdb new file mode 100644 index 0000000..94231ea Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdb differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdx b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdx new file mode 100644 index 0000000..d11546e Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_6489181f762332ef5d1cf7e95fcb6217.rdx differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.RData b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.RData deleted file mode 100644 index 1c0796d..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.RData and /dev/null differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdb b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdb deleted file mode 100644 index 0eeafcb..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdb and /dev/null differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdx b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdx deleted file mode 100644 index 36b87bc..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-4_673e54ea6ff0db4327f416266559180b.rdx and /dev/null differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.RData b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.RData new file mode 100644 index 0000000..0e44135 Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.RData differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdb b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdb new file mode 100644 index 0000000..1dd3b44 Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdb differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdx b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdx new file mode 100644 index 0000000..ba831cb Binary files /dev/null and b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_9b4dbefe00f65f0b71e779f116b739a6.rdx differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.RData b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.RData deleted file mode 100644 index 8fbad8d..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.RData and /dev/null differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdb b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdb deleted file mode 100644 index 5cd2ab8..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdb and /dev/null differ diff --git a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdx b/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdx deleted file mode 100644 index 6828057..0000000 Binary files a/boots.lmer/vignettes/create_lmer_fits_cache/html/unnamed-chunk-5_e28bf954038863d42bf90920f2cb43d7.rdx and /dev/null differ