1### runit.CV.R: test functions for checking cross-validation functions 2### By Bjørn-Helge Mevik 3### Started 2007-10-18 4 5## Parallel computations, crossval: 6test.crossval.parallel <- function() { 7 ## Make sure we start with a `clean slate' 8 pls.options(parallel = NULL) 9 10 ## Create a baseline version to compare the parallel results with: 11 plsmod <- plsr(octane ~ NIR, ncomp = 5, data = gasoline) 12 serial <- crossval(plsmod, length.seg = 1, segment.type = "cons") 13 14 ## mclapply: 15 if (.Platform$OS.type != "windows") { 16 pls.options(parallel = 2) 17 parallel <- crossval(plsmod, length.seg = 1, segment.type = "cons") 18 checkEquals(serial, parallel, "mclapply") 19 } 20 21 ## Auto-created FORK cluster: 22 if (.Platform$OS.type != "windows") { 23 pls.options(parallel = quote(parallel::makeCluster(2, type = "FORK"))) 24 parallel <- crossval(plsmod, length.seg = 1, segment.type = "cons") 25 checkEquals(serial, parallel, "parLapply, auto-created FORK cluster") 26 } 27 28 ## Auto-created PSOCK cluster: 29 pls.options(parallel = quote(parallel::makeCluster(2, type = "PSOCK"))) 30 parallel <- crossval(plsmod, length.seg = 1, segment.type = "cons") 31 checkEquals(serial, parallel, "parLapply, auto-created PSOCK cluster") 32 33 ## The rest of the tests use parallel functions directly: 34 require(parallel) 35 36 ## Permanent FORK cluster: 37 if (.Platform$OS.type != "windows") { 38 pls.options(parallel = makeCluster(2, type = "FORK")) 39 parallel <- crossval(plsmod, length.seg = 1, segment.type = "cons") 40 stopCluster(pls.options()$parallel) 41 checkEquals(serial, parallel, "parLapply, permanent FORK cluster") 42 } 43 44 ## Permanent PSOCK cluster: 45 pls.options(parallel = makeCluster(2, type = "PSOCK")) 46 parallel <- crossval(plsmod, length.seg = 1, segment.type = "cons") 47 stopCluster(pls.options()$parallel) 48 checkEquals(serial, parallel, "parLapply, permanent PSOCK cluster") 49 50 ## Clean up. Note: this will not run if any check above fails: 51 pls.options(parallel = NULL) 52} 53 54## Parallel computations, calling pls:::mvrCv directly: 55test.mvrCv.parallel <- function() { 56 ## Make sure we start with a `clean slate' 57 pls.options(parallel = NULL) 58 59 ## Create a baseline version to compare the parallel results with: 60 serial <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 61 length.seg = 1, segment.type = "cons") 62 63 ## mclapply: 64 if (.Platform$OS.type != "windows") { 65 pls.options(parallel = 2) 66 parallel <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 67 length.seg = 1, segment.type = "cons") 68 checkEquals(serial, parallel, "mclapply") 69 } 70 71 ## Auto-created FORK cluster: 72 if (.Platform$OS.type != "windows") { 73 pls.options(parallel = quote(parallel::makeCluster(2, type = "FORK"))) 74 parallel <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 75 length.seg = 1, segment.type = "cons") 76 checkEquals(serial, parallel, "parLapply, auto-created FORK cluster") 77 } 78 79 ## Auto-created PSOCK cluster: 80 pls.options(parallel = quote(parallel::makeCluster(2, type = "PSOCK"))) 81 parallel <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 82 length.seg = 1, segment.type = "cons") 83 checkEquals(serial, parallel, "parLapply, auto-created PSOCK cluster") 84 85 ## The rest of the tests use parallel functions directly: 86 require(parallel) 87 88 ## Permanent FORK cluster: 89 if (.Platform$OS.type != "windows") { 90 pls.options(parallel = makeCluster(2, type = "FORK")) 91 parallel <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 92 length.seg = 1, segment.type = "cons") 93 stopCluster(pls.options()$parallel) 94 checkEquals(serial, parallel, "parLapply, permanent FORK cluster") 95 } 96 97 ## Permanent PSOCK cluster: 98 pls.options(parallel = makeCluster(2, type = "PSOCK")) 99 parallel <- pls:::mvrCv(gasoline$NIR, gasoline$octane, 5, 100 length.seg = 1, segment.type = "cons") 101 stopCluster(pls.options()$parallel) 102 checkEquals(serial, parallel, "parLapply, permanent PSOCK cluster") 103 104 ## Clean up. Note: this will not run if any check above fails: 105 pls.options(parallel = NULL) 106} 107 108 109## A fake test function to make sure parallelism is turned off after 110## the test.*.parallel tests: 111test.parallel.cleanup <- function() { 112 pls.options(parallel = NULL) 113} 114