@gvegayon I encounter core errors now, without knowing why. If you tr…

…y to run the example code that's provided for boots.lmer funciton, especially this line below:

lmer.out<-boots.lmer(y="Y", X=c("X1","X2","X3"), dat=example.dat, boots.samples.list = output)

I get the following error:

Warning message:
In parallel::mclapply(boots.samples.list, function(boots.dat) { :
  all scheduled cores encountered errors in user code

But if you check my boots.lmer function, I set the number of cores to 2 so that it can pass CRAN check and all that so I'm not sure why I'm getting this error. Any suggestions?

UofUEpiBio/PHS7045-advanced-programming#13

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")

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){
 
 
 

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))

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
 
 ```