## Generated by dust (version 0.14.8) - do not edit
logistic <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = list(r = list(required = TRUE),
K = list(required = TRUE),
v = list(required = FALSE),
random_initial = list(required = FALSE)),
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_ode_logistic_alloc,
run = dust_ode_logistic_run,
simulate = dust_ode_logistic_simulate,
run_adjoint = dust_ode_logistic_run_adjoint,
set_index = dust_ode_logistic_set_index,
n_state = dust_ode_logistic_n_state,
update_state = dust_ode_logistic_update_state,
state = dust_ode_logistic_state,
time = dust_ode_logistic_time,
reorder = dust_ode_logistic_reorder,
resample = dust_ode_logistic_resample,
rng_state = dust_ode_logistic_rng_state,
set_rng_state = dust_ode_logistic_set_rng_state,
set_n_threads = dust_ode_logistic_set_n_threads,
set_data = dust_ode_logistic_set_data,
compare_data = dust_ode_logistic_compare_data,
filter = dust_ode_logistic_filter,
set_stochastic_schedule = dust_ode_logistic_set_stochastic_schedule,
ode_statistics = dust_ode_logistic_ode_statistics)
} else {
private$methods_ <- list(alloc = function(...) {
stop("GPU support not enabled for this object")
})
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"logistic"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_ode_logistic_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
FALSE
} else {
dust_ode_logistic_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_ode_logistic_capabilities()[["compare"]]
},
real_size = function() {
dust_ode_logistic_capabilities()[["real_size"]]
},
time_type = function() {
dust_ode_logistic_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_ode_logistic_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_logistic_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(logistic) <- c("dust_generator", class(logistic))
sir <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = list(I0 = list(required = FALSE),
beta = list(required = FALSE),
gamma = list(required = FALSE),
exp_noise = list(required = FALSE)),
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_cpu_sir_alloc,
run = dust_cpu_sir_run,
simulate = dust_cpu_sir_simulate,
run_adjoint = dust_cpu_sir_run_adjoint,
set_index = dust_cpu_sir_set_index,
n_state = dust_cpu_sir_n_state,
update_state = dust_cpu_sir_update_state,
state = dust_cpu_sir_state,
time = dust_cpu_sir_time,
reorder = dust_cpu_sir_reorder,
resample = dust_cpu_sir_resample,
rng_state = dust_cpu_sir_rng_state,
set_rng_state = dust_cpu_sir_set_rng_state,
set_n_threads = dust_cpu_sir_set_n_threads,
set_data = dust_cpu_sir_set_data,
compare_data = dust_cpu_sir_compare_data,
filter = dust_cpu_sir_filter,
set_stochastic_schedule = dust_cpu_sir_set_stochastic_schedule,
ode_statistics = dust_cpu_sir_ode_statistics)
} else {
private$methods_ <- list(alloc = function(...) {
stop("GPU support not enabled for this object")
})
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"sir"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_cpu_sir_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
FALSE
} else {
dust_cpu_sir_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_cpu_sir_capabilities()[["compare"]]
},
real_size = function() {
dust_cpu_sir_capabilities()[["real_size"]]
},
time_type = function() {
dust_cpu_sir_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_cpu_sir_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_sir_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(sir) <- c("dust_generator", class(sir))
sirs <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = list(freq = list(required = FALSE, default = 1),
alpha = list(required = FALSE, default = 0.1),
beta = list(required = FALSE, default = 0.2),
gamma = list(required = FALSE, default = 0.1)),
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_cpu_sirs_alloc,
run = dust_cpu_sirs_run,
simulate = dust_cpu_sirs_simulate,
run_adjoint = dust_cpu_sirs_run_adjoint,
set_index = dust_cpu_sirs_set_index,
n_state = dust_cpu_sirs_n_state,
update_state = dust_cpu_sirs_update_state,
state = dust_cpu_sirs_state,
time = dust_cpu_sirs_time,
reorder = dust_cpu_sirs_reorder,
resample = dust_cpu_sirs_resample,
rng_state = dust_cpu_sirs_rng_state,
set_rng_state = dust_cpu_sirs_set_rng_state,
set_n_threads = dust_cpu_sirs_set_n_threads,
set_data = dust_cpu_sirs_set_data,
compare_data = dust_cpu_sirs_compare_data,
filter = dust_cpu_sirs_filter,
set_stochastic_schedule = dust_cpu_sirs_set_stochastic_schedule,
ode_statistics = dust_cpu_sirs_ode_statistics)
} else {
private$methods_ <- list(
alloc = dust_gpu_sirs_alloc,
run = dust_gpu_sirs_run,
simulate = dust_gpu_sirs_simulate,
run_adjoint = dust_gpu_sirs_run_adjoint,
set_index = dust_gpu_sirs_set_index,
n_state = dust_gpu_sirs_n_state,
update_state = dust_gpu_sirs_update_state,
state = dust_gpu_sirs_state,
time = dust_gpu_sirs_time,
reorder = dust_gpu_sirs_reorder,
resample = dust_gpu_sirs_resample,
rng_state = dust_gpu_sirs_rng_state,
set_rng_state = dust_gpu_sirs_set_rng_state,
set_n_threads = dust_gpu_sirs_set_n_threads,
set_data = dust_gpu_sirs_set_data,
compare_data = dust_gpu_sirs_compare_data,
filter = dust_gpu_sirs_filter,
set_stochastic_schedule = dust_gpu_sirs_set_stochastic_schedule,
ode_statistics = dust_gpu_sirs_ode_statistics)
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"sirs"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_cpu_sirs_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
TRUE
} else {
dust_cpu_sirs_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_cpu_sirs_capabilities()[["compare"]]
},
real_size = function() {
dust_cpu_sirs_capabilities()[["real_size"]]
},
time_type = function() {
dust_cpu_sirs_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_cpu_sirs_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_sirs_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(sirs) <- c("dust_generator", class(sirs))
variable <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = NULL,
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_cpu_variable_alloc,
run = dust_cpu_variable_run,
simulate = dust_cpu_variable_simulate,
run_adjoint = dust_cpu_variable_run_adjoint,
set_index = dust_cpu_variable_set_index,
n_state = dust_cpu_variable_n_state,
update_state = dust_cpu_variable_update_state,
state = dust_cpu_variable_state,
time = dust_cpu_variable_time,
reorder = dust_cpu_variable_reorder,
resample = dust_cpu_variable_resample,
rng_state = dust_cpu_variable_rng_state,
set_rng_state = dust_cpu_variable_set_rng_state,
set_n_threads = dust_cpu_variable_set_n_threads,
set_data = dust_cpu_variable_set_data,
compare_data = dust_cpu_variable_compare_data,
filter = dust_cpu_variable_filter,
set_stochastic_schedule = dust_cpu_variable_set_stochastic_schedule,
ode_statistics = dust_cpu_variable_ode_statistics)
} else {
private$methods_ <- list(
alloc = dust_gpu_variable_alloc,
run = dust_gpu_variable_run,
simulate = dust_gpu_variable_simulate,
run_adjoint = dust_gpu_variable_run_adjoint,
set_index = dust_gpu_variable_set_index,
n_state = dust_gpu_variable_n_state,
update_state = dust_gpu_variable_update_state,
state = dust_gpu_variable_state,
time = dust_gpu_variable_time,
reorder = dust_gpu_variable_reorder,
resample = dust_gpu_variable_resample,
rng_state = dust_gpu_variable_rng_state,
set_rng_state = dust_gpu_variable_set_rng_state,
set_n_threads = dust_gpu_variable_set_n_threads,
set_data = dust_gpu_variable_set_data,
compare_data = dust_gpu_variable_compare_data,
filter = dust_gpu_variable_filter,
set_stochastic_schedule = dust_gpu_variable_set_stochastic_schedule,
ode_statistics = dust_gpu_variable_ode_statistics)
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"variable"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_cpu_variable_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
TRUE
} else {
dust_cpu_variable_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_cpu_variable_capabilities()[["compare"]]
},
real_size = function() {
dust_cpu_variable_capabilities()[["real_size"]]
},
time_type = function() {
dust_cpu_variable_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_cpu_variable_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_variable_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(variable) <- c("dust_generator", class(variable))
volatility <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = NULL,
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_cpu_volatility_alloc,
run = dust_cpu_volatility_run,
simulate = dust_cpu_volatility_simulate,
run_adjoint = dust_cpu_volatility_run_adjoint,
set_index = dust_cpu_volatility_set_index,
n_state = dust_cpu_volatility_n_state,
update_state = dust_cpu_volatility_update_state,
state = dust_cpu_volatility_state,
time = dust_cpu_volatility_time,
reorder = dust_cpu_volatility_reorder,
resample = dust_cpu_volatility_resample,
rng_state = dust_cpu_volatility_rng_state,
set_rng_state = dust_cpu_volatility_set_rng_state,
set_n_threads = dust_cpu_volatility_set_n_threads,
set_data = dust_cpu_volatility_set_data,
compare_data = dust_cpu_volatility_compare_data,
filter = dust_cpu_volatility_filter,
set_stochastic_schedule = dust_cpu_volatility_set_stochastic_schedule,
ode_statistics = dust_cpu_volatility_ode_statistics)
} else {
private$methods_ <- list(alloc = function(...) {
stop("GPU support not enabled for this object")
})
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"volatility"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_cpu_volatility_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
FALSE
} else {
dust_cpu_volatility_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_cpu_volatility_capabilities()[["compare"]]
},
real_size = function() {
dust_cpu_volatility_capabilities()[["real_size"]]
},
time_type = function() {
dust_cpu_volatility_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_cpu_volatility_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_volatility_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(volatility) <- c("dust_generator", class(volatility))
walk <- R6::R6Class(
"dust",
cloneable = FALSE,
private = list(
pars_ = NULL,
pars_multi_ = NULL,
index_ = NULL,
info_ = NULL,
n_threads_ = NULL,
n_particles_ = NULL,
n_particles_each_ = NULL,
shape_ = NULL,
ptr_ = NULL,
gpu_config_ = NULL,
ode_control_ = NULL,
methods_ = NULL,
param_ = NULL,
reload_ = NULL
),
public = list(
initialize = function(pars, time, n_particles, n_threads = 1L,
seed = NULL, pars_multi = FALSE,
deterministic = FALSE,
gpu_config = NULL, ode_control = NULL) {
if (is.null(gpu_config)) {
private$methods_ <- list(
alloc = dust_cpu_walk_alloc,
run = dust_cpu_walk_run,
simulate = dust_cpu_walk_simulate,
run_adjoint = dust_cpu_walk_run_adjoint,
set_index = dust_cpu_walk_set_index,
n_state = dust_cpu_walk_n_state,
update_state = dust_cpu_walk_update_state,
state = dust_cpu_walk_state,
time = dust_cpu_walk_time,
reorder = dust_cpu_walk_reorder,
resample = dust_cpu_walk_resample,
rng_state = dust_cpu_walk_rng_state,
set_rng_state = dust_cpu_walk_set_rng_state,
set_n_threads = dust_cpu_walk_set_n_threads,
set_data = dust_cpu_walk_set_data,
compare_data = dust_cpu_walk_compare_data,
filter = dust_cpu_walk_filter,
set_stochastic_schedule = dust_cpu_walk_set_stochastic_schedule,
ode_statistics = dust_cpu_walk_ode_statistics)
} else {
private$methods_ <- list(alloc = function(...) {
stop("GPU support not enabled for this object")
})
}
res <- private$methods_$alloc(pars, pars_multi, time, n_particles,
n_threads, seed, deterministic, gpu_config, ode_control)
private$pars_ <- pars
private$pars_multi_ <- pars_multi
private$n_threads_ <- n_threads
private$ptr_ <- res[[1L]]
private$info_ <- res[[2L]]
private$shape_ <- res[[3L]]
private$gpu_config_ <- res[[4L]]
private$ode_control_ <- res[[5L]]
private$n_particles_ <- prod(private$shape_)
if (pars_multi) {
private$n_particles_each_ <- private$n_particles_ / length(pars)
} else {
private$n_particles_each_ <- private$n_particles_
}
},
name = function() {
"walk"
},
param = function() {
private$param_
},
run = function(time_end) {
m <- private$methods_$run(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
simulate = function(time_end) {
m <- private$methods_$simulate(private$ptr_, time_end)
rownames(m) <- names(private$index_)
m
},
run_adjoint = function() {
private$methods_$run_adjoint(private$ptr_)
},
set_index = function(index) {
private$methods_$set_index(private$ptr_, index)
private$index_ <- index
invisible()
},
index = function() {
private$index_
},
ode_control = function() {
private$ode_control_
},
ode_statistics = function() {
private$methods_$ode_statistics(private$ptr_)
},
n_threads = function() {
private$n_threads_
},
n_state = function() {
private$methods_$n_state(private$ptr_)
},
n_particles = function() {
private$n_particles_
},
n_particles_each = function() {
private$n_particles_each_
},
shape = function() {
private$shape_
},
update_state = function(pars = NULL, state = NULL, time = NULL,
set_initial_state = NULL, index = NULL,
reset_step_size = NULL) {
info <- private$methods_$update_state(private$ptr_, pars, state, time,
set_initial_state, index,
reset_step_size)
if (!is.null(pars)) {
private$info_ <- info
private$pars_ <- pars
}
invisible()
},
state = function(index = NULL) {
m <- private$methods_$state(private$ptr_, index)
rownames(m) <- names(index)
m
},
time = function() {
private$methods_$time(private$ptr_)
},
set_stochastic_schedule = function(time) {
private$methods_$set_stochastic_schedule(private$ptr_, time)
invisible()
},
reorder = function(index) {
storage.mode(index) <- "integer"
private$methods_$reorder(private$ptr_, index)
invisible()
},
resample = function(weights) {
invisible(private$methods_$resample(private$ptr_, weights))
},
info = function() {
private$info_
},
pars = function() {
private$pars_
},
rng_state = function(first_only = FALSE, last_only = FALSE) {
private$methods_$rng_state(private$ptr_, first_only, last_only)
},
set_rng_state = function(rng_state) {
private$methods_$set_rng_state(private$ptr_, rng_state)
invisible()
},
has_openmp = function() {
dust_cpu_walk_capabilities()[["openmp"]]
},
has_gpu_support = function(fake_gpu = FALSE) {
if (fake_gpu) {
FALSE
} else {
dust_cpu_walk_capabilities()[["gpu"]]
}
},
has_compare = function() {
dust_cpu_walk_capabilities()[["compare"]]
},
real_size = function() {
dust_cpu_walk_capabilities()[["real_size"]]
},
time_type = function() {
dust_cpu_walk_capabilities()[["time_type"]]
},
rng_algorithm = function() {
dust_cpu_walk_capabilities()[["rng_algorithm"]]
},
uses_gpu = function(fake_gpu = FALSE) {
real_gpu <- private$gpu_config_$real_gpu
!is.null(real_gpu) && (fake_gpu || real_gpu)
},
n_pars = function() {
if (private$pars_multi_) length(private$pars_) else 0L
},
set_n_threads = function(n_threads) {
prev <- private$n_threads_
private$methods_$set_n_threads(private$ptr_, n_threads)
private$n_threads_ <- n_threads
invisible(prev)
},
set_data = function(data, shared = FALSE) {
private$methods_$set_data(private$ptr_, data, shared)
},
compare_data = function() {
private$methods_$compare_data(private$ptr_)
},
filter = function(time_end = NULL, save_trajectories = FALSE,
time_snapshot = NULL, min_log_likelihood = NULL) {
private$methods_$filter(private$ptr_, time_end, save_trajectories,
time_snapshot, min_log_likelihood)
},
gpu_info = function() {
ret <- dust_walk_gpu_info()
ret$devices <- as.data.frame(ret$devices, stringsAsFactors = FALSE)
parent <- parent.env(environment())
if (ret$has_cuda && exists("private", parent, inherits = FALSE)) {
ret$config <- private$gpu_config_
}
ret
}
))
class(walk) <- c("dust_generator", class(walk))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.