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