R/dust.R

## 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))
mrc-ide/dust documentation built on May 11, 2024, 1:08 p.m.