1## this is the simpler version of the code for testing/exercising 2## https://github.com/lme4/lme4/issues/35 3## see also ../misc/issues/dynload.R for more complexity 4pkg <- so_name <- "lme4"; doUnload <- FALSE; doTest <- TRUE 5## pkg <- so_name <- "RcppEigen"; doUnload <- TRUE; doTest <- TRUE 6## need to deal with the fact that DLL name != package name for lme4.0 ... 7### pkg <- "lme4.0"; so_name <- "lme4"; doUnload <- TRUE 8instPkgs <- as.data.frame(installed.packages(),stringsAsFactors=FALSE) 9Load <- function() { 10 library(pkg,character.only=TRUE) 11} 12Unload <- function() { 13 ld <- library.dynam() 14 pnames <- sapply(ld,"[[","name") 15 names(ld) <- pnames 16 lp <- gsub("/libs/.*$","",ld[[so_name]][["path"]]) 17 cat("unloading from",lp,"\n") 18 library.dynam.unload(so_name, lp) 19} 20Detach <- function() { 21 detach(paste0("package:",pkg),character.only=TRUE,unload=TRUE) 22 if (doUnload) Unload() 23} 24tmpf <- function() { 25 g <- getLoadedDLLs() 26 lnames <- names(g)[is.na(instPkgs[names(g),"Priority"])] 27 cat("loaded DLLs:",lnames,"\n") 28 g <- g[na.omit(match(c(so_name,"nlme"),names(g)))] 29 class(g) <- "DLLInfoList" 30 g 31} 32test <- function() { 33 if (doTest) { 34 if (pkg %in% c("lme4","lme4.0")) { 35 fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, 36 devFunOnly=TRUE) 37 } 38 if (pkg=="RcppEigen") { 39 data(trees, package="datasets") 40 mm <- cbind(1, log(trees$Girth)) # model matrix 41 y <- log(trees$Volume) # response 42 ## bare-bones direct interface 43 flm <- fastLmPure(mm, y) 44 } 45 } 46} 47if (FALSE) { 48 ## FIXME: disabled test for now 49for (i in 1:6) { 50 cat("Attempt #",i,"\n",sep="") 51 cat("loading",pkg,"\n") 52 Load() 53 tmpf() 54 test() 55 cat("detaching",pkg,"\n") 56 Detach() 57 cat("loading nlme\n") 58 library("nlme") 59 tmpf() 60 detach("package:nlme",unload=TRUE) 61 cat("detaching nlme\n") 62} 63} 64