1### * <HEADER> 2### 3attach(NULL, name = "CheckExEnv") 4assign("nameEx", 5 local({ 6 s <- "__{must remake R-ex/*.R}__" 7 function(new) { 8 if(!missing(new)) s <<- new else s 9 } 10 }), 11 pos = "CheckExEnv") 12## Add some hooks to label plot pages for base and grid graphics 13assign("base_plot_hook", 14 function() { 15 pp <- graphics::par(c("mfg","mfcol","oma","mar")) 16 if(all(pp$mfg[1:2] == c(1, pp$mfcol[2]))) { 17 outer <- (oma4 <- pp$oma[4]) > 0; mar4 <- pp$mar[4] 18 graphics::mtext(sprintf("help(\"%s\")", nameEx()), side = 4, 19 line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1), 20 outer = outer, adj = 1, cex = 0.8, col = "orchid", las = 3) 21 } 22 }, 23 pos = "CheckExEnv") 24assign("grid_plot_hook", 25 function() { 26 grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") - 27 grid::unit(1, "lines"), x=0, just="left")) 28 grid::grid.text(sprintf("help(\"%s\")", nameEx()), 29 x=grid::unit(1, "npc") + grid::unit(0.5, "lines"), 30 y=grid::unit(0.8, "npc"), rot=90, 31 gp=grid::gpar(col="orchid")) 32 }, 33 pos = "CheckExEnv") 34setHook("plot.new", get("base_plot_hook", pos = "CheckExEnv")) 35setHook("persp", get("base_plot_hook", pos = "CheckExEnv")) 36setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv")) 37assign("cleanEx", 38 function(env = .GlobalEnv) { 39 rm(list = ls(envir = env, all.names = TRUE), envir = env) 40 RNGkind("default", "default", "default") 41 set.seed(1) 42 options(warn = 1) 43 .CheckExEnv <- as.environment("CheckExEnv") 44 delayedAssign("T", stop("T used instead of TRUE", domain = NA), 45 assign.env = .CheckExEnv) 46 delayedAssign("F", stop("F used instead of FALSE", domain = NA), 47 assign.env = .CheckExEnv) 48 sch <- search() 49 newitems <- sch[! sch %in% .oldSearch] 50 if(length(newitems)) tools:::detachPackages(newitems) 51 missitems <- .oldSearch[! .oldSearch %in% sch] 52 if(length(missitems)) 53 warning(sprintf("items %s were removed from the search path", 54 paste(sQuote(missitems), collapse=", ")), 55 call. = FALSE, immediate. = TRUE, domain = NA) 56 ## Old massaged files will not have set .old_wd. 57 if(exists(".old_wd") && (wd <- getwd()) != .old_wd) { 58 warning(sprintf("working directory was changed to %s, resetting", 59 sQuote(wd)), 60 call. = FALSE, immediate. = TRUE, domain = NA) 61 setwd(.old_wd) 62 } 63 ## stop in case users left connections open, 64 ## also indicating that parallel cluster are still running 65 if(Sys.getenv("_R_CHECK_CONNECTIONS_LEFT_OPEN_", FALSE)){ 66 sC <- showConnections() 67 if(nrow(sC)){ 68 stop("connections left open:\n", 69 paste(apply(sC[,1:2, drop = FALSE], 1L, function(x) 70 paste0("\t", x[1L], " (", x[2L], ")")), collapse="\n"), 71 call. = FALSE, domain = NA) 72 } 73 } 74 }, 75 pos = "CheckExEnv") 76assign("ptime", proc.time(), pos = "CheckExEnv") 77## Do this before loading the package, 78## since packages have been known to change settings. 79## Force a size that is close to on-screen devices, fix paper. 80## don't rename par.postscript for back-compatibility of reference output. 81grDevices::pdf.options(width = 7, height = 7, paper = "special", reset = TRUE) 82grDevices::pdf(paste(pkgname, "-Ex.pdf", sep=""), encoding = "ISOLatin1") 83 84assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv") 85options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly")) 86