1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
### =========================================================================
### MulticoreParam objects
### -------------------------------------------------------------------------
multicoreWorkers <- function()
.snowCores("multicore")
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Constructor
###
.MulticoreParam_prototype <- .SnowParam_prototype
.MulticoreParam <- setRefClass("MulticoreParam",
contains="SnowParam",
fields=list(),
methods=list()
)
MulticoreParam <- function(workers=multicoreWorkers(), tasks=0L,
stop.on.error=TRUE,
progressbar=FALSE, RNGseed=NULL, timeout= WORKER_TIMEOUT,
exportglobals=TRUE,
log=FALSE, threshold="INFO", logdir=NA_character_,
resultdir=NA_character_, jobname = "BPJOB",
force.GC = FALSE,
fallback = TRUE,
manager.hostname=NA_character_, manager.port=NA_integer_, ...)
{
if (.Platform$OS.type == "windows") {
warning("MulticoreParam() not supported on Windows, use SnowParam()")
workers = 1L
}
if (progressbar && missing(tasks))
tasks <- TASKS_MAXIMUM
clusterargs <- c(list(spec=workers, type="FORK"), list(...))
manager.hostname <-
if (is.na(manager.hostname)) {
local <- (clusterargs$type == "FORK") ||
is.numeric(clusterargs$spec)
manager.hostname <- .snowHost(local)
} else as.character(manager.hostname)
manager.port <-
if (is.na(manager.port)) {
.snowPort()
} else as.integer(manager.port)
if (!is.null(RNGseed))
RNGseed <- as.integer(RNGseed)
prototype <- .prototype_update(
.MulticoreParam_prototype,
.clusterargs=clusterargs, cluster=.NULLcluster(),
.controlled=TRUE, workers=as.integer(workers),
tasks=as.integer(tasks),
stop.on.error=stop.on.error,
progressbar=progressbar,
RNGseed=RNGseed, timeout=as.integer(timeout),
exportglobals=exportglobals,
exportvariables=FALSE,
log=log, threshold=threshold,
logdir=logdir, resultdir=resultdir, jobname=jobname,
force.GC = force.GC,
fallback = fallback,
hostname=manager.hostname, port=manager.port,
...
)
param <- do.call(.MulticoreParam, prototype)
bpworkers(param) <- workers # enforce worker number
validObject(param)
param
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Methods - control
###
setReplaceMethod("bpworkers", c("MulticoreParam", "numeric"),
function(x, value)
{
value <- as.integer(value)
nworkers <- .enforceWorkers(value, x$.clusterargs$type)
x$workers <- x$.clusterargs$spec <- nworkers
x
})
setMethod("bpschedule", "MulticoreParam",
function(x)
{
if (.Platform$OS.type == "windows")
FALSE
else
TRUE
})
|
