Advertisement
Guest User

Untitled

a guest
Jun 24th, 2019
102
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.40 KB | None | 0 0
  1. library(mice)
  2. Data <- subset(Data0, select=c(id, faculty, gender, age, age_sqr, occupation, degree, private_sector, overtime, wage))
  3. ini <- mice(Data, maxit=0, pri=F) #get predictor matrix
  4. pred <- ini$pred
  5. pred[,"id"] <- 0 #don't use id as predictor
  6. meth <- ini$meth
  7. meth[c("id", "faculty", "gender", "age", "age_sqr", "occupation", "degree", "private_sector", "overtime", "wage")] <- "" #don't impute these variables, use only as predictors.
  8. imp <- mice(Data, m=22, maxit=10, printFlag=TRUE, pred=pred, meth=meth) #impute Data with 22 imputations and 10 iterations.
  9.  
  10. library(lme4)
  11. fm1 <- with(imp, lmer(log(wage) ~ gender + age + age_sqr + occupation + degree + private_sector + overtime + (1+gender|faculty))) #my multilevel model
  12. summary(est <- pool(fm1)) #pool my results
  13.  
  14. > summary(est <- pool(fm1))
  15. est se t df Pr(>|t|) lo 95 hi 95 nmis fmi lambda
  16. (Intercept) 7,635148e+00 0,1749178710 43,649905006 212,5553 0,000000e+00 7,2903525425 7,9799443672 NA 0,2632782 0,2563786
  17. Gender -1,094186e-01 0,0286629154 -3,817427078 117,1059 2,171066e-04 -0,1661834550 -0,0526537238 NA 0,3846276 0,3742069
  18. Occupation1 1,125022e-01 0,0250082538 4,498601518 157,6557 1,320753e-05 0,0631077322 0,1618966049 NA 0,3207350 0,3121722
  19. Occupation2 2,753089e-02 0,0176032487 1,563966385 215,6197 1,192919e-01 -0,0071655902 0,0622273689 NA 0,2606725 0,2538465
  20. Occupation3 1,881908e-04 0,0221992053 0,008477365 235,3705 9,932433e-01 -0,0435463305 0,0439227120 NA 0,2449795 0,2385910
  21. Age 1,131147e-02 0,0087366178 1,294719230 187,0021 1,970135e-01 -0,0059235288 0,0285464629 0 0,2871640 0,2795807
  22. Age_sqr -7,790476e-05 0,0001033263 -0,753968159 185,4630 4,518245e-01 -0,0002817508 0,0001259413 0 0,2887420 0,2811131
  23. Overtime -2,376501e-03 0,0004065466 -5,845581504 243,3563 1,614693e-08 -0,0031773002 -0,0015757019 9 0,2391179 0,2328903
  24. Private_sector 8,322438e-02 0,0203047665 4,098760934 371,9971 5,102752e-05 0,0432978716 0,1231508962 NA 0,1688478 0,1643912
  25.  
  26. Random effects:
  27. Groups Name Variance Std.Dev. Corr
  28. Faculty (Intercept) 0,008383 0,09156
  29. Genderfemale0,002240 0,04732 1,00
  30. Residual 0,041845 0,20456
  31. Number of obs: 698, groups: Faculty, 17
  32.  
  33. library(Amelia)
  34. library(lme4)
  35. library(merTools)
  36. library(plyr) # for collapsing estimates
  37.  
  38. a.out <- amelia(dat[sub1, varIndex], idvars = "SCH_ID",
  39. noms = varIndex[!varIndex %in% c("SCH_ID", "math12")],
  40. m = 10)
  41.  
  42. mods <- lapply(a.out$imputations,
  43. function(d) lmer((log(wage) ~ gender + age + age_sqr +
  44. occupation + degree + private_sector + overtime +
  45. (1+gender|faculty), data = d)
  46.  
  47. imputeFEs <- ldply(mods, FEsim, nsims = 1000)
  48. imputeREs <- ldply(mods, REsim, nsims = 1000)
  49.  
  50. imputeREs <- ddply(imputeREs, .(X1, X2), summarize, mean = mean(mean),
  51. median = mean(median), sd = mean(sd),
  52. level = level[1])
  53.  
  54. imputeFEs <- ddply(imputeFEs, .(var), summarize, meanEff = mean(meanEff),
  55. medEff = mean(medEff), sdEff = mean(sdEff))
  56.  
  57. REsdExtract <- function(model){
  58. out <- unlist(lapply(VarCorr(model), attr, "stddev"))
  59. return(out)
  60. }
  61.  
  62. REcorrExtract <- function(model){
  63. out <- unlist(lapply(VarCorr(model), attr, "corre"))
  64. return(min(unique(out)))
  65. }
  66.  
  67. modStats <- cbind(ldply(mods, REsdExtract), ldply(mods, REcorrExtract))
  68.  
  69. # Functions to extract standard deviation of random effects from model
  70. REsdExtract <- function(model){
  71. out <- unlist(lapply(VarCorr(model), attr, "stddev"))
  72. return(out)
  73. }
  74.  
  75. #slope intercept correlation from model
  76. REcorrExtract <- function(model){
  77. out <- unlist(lapply(VarCorr(model), attr, "corre"))
  78. return(min(unique(out)))
  79. }
  80.  
  81. modelRandEffStats <- function(modList){
  82. SDs <- ldply(modList, REsdExtract)
  83. corrs <- ldply(modList, REcorrExtract)
  84. tmp <- cbind(SDs, corrs)
  85. names(tmp) <- c("Imp", "Int", "Slope", "id", "Corr")
  86. out <- data.frame(IntSD_mean = mean(tmp$Int),
  87. SlopeSD_mean = mean(tmp$Slope),
  88. Corr_mean = mean(tmp$Corr),
  89. IntSD_sd = sd(tmp$Int),
  90. SlopeSD_sd = sd(tmp$Slope),
  91. Corr_sd = sd(tmp$Corr))
  92. return(out)
  93. }
  94.  
  95. modelFixedEff <- function(modList){
  96. require(broom)
  97. fixEst <- ldply(modList, tidy, effects = "fixed")
  98. # Collapse
  99. out <- ddply(fixEst, .(term), summarize,
  100. estimate = mean(estimate),
  101. std.error = mean(std.error))
  102. out$statistic <- out$estimate / out$std.error
  103. return(out)
  104. }
  105.  
  106. print.merModList <- function(modList, digits = 3){
  107. len <- length(modList)
  108. form <- modList[[1]]@call
  109. print(form)
  110. cat("nFixed Effects:n")
  111. fedat <- modelFixedEff(modList)
  112. dimnames(fedat)[[1]] <- fedat$term
  113. pfround(fedat[-1, -1], digits)
  114. cat("nError Terms Random Effect Std. Devsn")
  115. cat("and covariances:n")
  116. cat("n")
  117. ngrps <- length(VarCorr(modmathG[[1]]))
  118. errorList <- vector(mode = 'list', length = ngrps)
  119. corrList <- vector(mode = 'list', length = ngrps)
  120. for(i in 1:ngrps){
  121. subList <- lapply(modList, function(x) VarCorr(x)[[i]])
  122. subList <- apply(simplify2array(subList), 1:2, mean)
  123. errorList[[i]] <- subList
  124. subList <- lapply(modList, function(x) attr(VarCorr(x)[[i]], "corre"))
  125. subList <- min(unique(apply(simplify2array(subList), 1:2, function(x) mean(x))))
  126. corrList[[i]] <- subList
  127. }
  128. errorList <- lapply(errorList, function(x) {
  129. diag(x) <- sqrt(diag(x))
  130. return(x)
  131. })
  132.  
  133. lapply(errorList, pfround, digits)
  134. cat("nError Term Correlations:n")
  135. lapply(corrList, pfround, digits)
  136. residError <- mean(unlist(lapply(modList, function(x) attr(VarCorr(x), "sc"))))
  137. cat("nResidual Error =", fround(residError,
  138. digits), "n")
  139. cat("n---Groupsn")
  140. ngrps <- lapply(modList[[1]]@flist, function(x) length(levels(x)))
  141. modn <- getME(modList[[1]], "devcomp")$dims["n"]
  142. cat(sprintf("number of obs: %d, groups: ", modn))
  143. cat(paste(paste(names(ngrps), ngrps, sep = ", "),
  144. collapse = "; "))
  145. cat("n")
  146. cat("nModel Fit Stats")
  147. mAIC <- mean(unlist(lapply(modList, AIC)))
  148. cat(sprintf("nAIC = %g", round(mAIC, 1)))
  149. moDsigma.hat <- mean(unlist(lapply(modmathG, sigma)))
  150. cat("nOverdispersion parameter =", fround(moDsigma.hat,
  151. digits), "n")
  152. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement