Сделать две мои разные функции R одной функцией

Я хочу использовать функцию MonteCarlo в пакете MonteCarlo в R, у которого есть одно требование среди других, как поставка just one single function в пакет MonteCarlo.

Чтобы запустить исследование с помощью моделирования, пользователь должен вложить как создание выборки, так и расчет желаемой статистики из этой выборки - в одну функцию. Эта функция передается в MonteCarlo (). Дополнительного программирования не требуется (Виньетка: пакет MonteCarlo < / а>).

Вопреки этому жизненно важному условию, у меня есть две разные функции, которые подходят моему алгоритму. Я использовал функцию MonteCarlo, как указано в правильном ответе в этот вопрос для метода.

Я хочу использовать другой метод, поэтому я пишу следующие функции (function1 и function2), чтобы они передавались функции MonteCarlo, как показано ниже:

Вот алгоритм того, что я хочу сделать с R:

  1. Имитация набора данных 10 временных рядов от модели ARIMA до функции arima.sim()
  2. Разделите серию на перекрывающиеся подсерии возможных 2s, 3s, 4s, 5s, 6s, 7s, 8s и 9s.
  3. Для каждого размера выполните повторную выборку блоков с заменой для новой серии и получите лучшую ARIMA модель из подсерий от каждого размера блока с помощью auto.arima() функции.
  4. Получить для каждой подсерии каждого размера блока RMSE.

Приведенные ниже R функции делают это.

library(MonteCarlo)
library(forecast)
library(Metrics)
############################################
function1 <- function(lb, ov, n) {

  starts <- unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb))))
  ends <- pmin(starts + lb - 1, n)

  # truncate starts and ends to the first num elements
  num <- match(n, ends)
  head(data.frame(starts, ends), num)
}
#############################################
# parameter grids
n <- 10 # length of time series
lb <- seq(n-2) + 1 # vector of block sizes
phi <- 0.6 # autoregressive parameter
reps <- 3 # monte carlo replications

# simulation function  
function2 <- function(n, lb, phi) {

  #### simulate ####
  ov <- ceiling(lb/2)
  vblocks <- Vectorize(function1, c("lb", "ov"), SIMPLIFY = FALSE)
  d <- vblocks(lb = lb, ov = ov, n = n)
  ts <- arima.sim(n, model = list(ar = phi, order = c(1, 0, 0)), sd = 1)

  #### devide ####
  blk <- lapply(d, function(x) with(x, Map(function(i, j) ts[i:j], starts, ends)))
  #### resample ####
  res <- sample(blk, replace = TRUE, 10)        # resamples the blocks
  res.unlist <- unlist(res, use.names = FALSE)   # unlist the bootstrap series
  #### train, forecast ####
  train <- head(res.unlist, round(length(res.unlist) - 10)) # train set
  test <- tail(res.unlist, length(res.unlist) - length(train)) # test set
  nfuture <- forecast(train, # forecast
                      model = auto.arima(train), 
                      lambda = 0, biasadj = TRUE, h = length(test))$mean    
  ### metric ####
  RMSE <- rmse(test, nfuture) # return RMSE
  return(
    list("RMSE" = RMSE)
  )
}

param_list = list("n" = n, "lb" = lb, "phi" = phi)

set.seed(123, kind = "L'Ecuyer-CMRG")
MC_result <- MonteCarlo(func = bootstrap4, 
                            nrep = reps,
                            ncpus = parallel::detectCores() - 1,
                            param_list = param_list,
                            export_also = list(
                              "packages" = c("forecast", "Metrics")
                            ),
                            raw = T)

Я получил эту ошибку, когда запустил вышеуказанное:

в снегопаде :: sfExport (func2, func, libloc_strings, function1,: Неизвестная / необнаруженная переменная заканчивается экспортом. (local = TRUE)

Я хочу интегрировать function1 в function2 таким образом, чтобы function1 не был функцией в function2.

вот моя пробная версия

function2 <- function(n, lb, phi) {

  #### simulate ####
  ov <- ceiling(lb/2)
  function1 <- head(data.frame(unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb)))), pmin(unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb)))) + lb - 1, n)), match(n, pmin(unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb)))) + lb - 1, n)))
  vblocks <- Vectorize(function1, c("lb", "ov"), SIMPLIFY = FALSE)
  d <- vblocks(lb = lb, ov = ov, n = n)
  ts <- arima.sim(n, model = list(ar = phi, order = c(1, 0, 0)), sd = 1)

  #### devide ####
    blk <- lapply(d, function(x) with(x, Map(function(i, j) ts[i:j], unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb)))), pmin(unique(sort(c(seq(1, n, lb), seq(lb-ov+1, n, lb)))) + lb - 1, n))))

  #### resample ####
  res <- sample(blk, replace = TRUE, 10)        # resamples the blocks
  res.unlist <- unlist(res, use.names = FALSE)   # unlist the bootstrap series
  #### train, forecast ####
  train <- head(res.unlist, round(length(res.unlist) - 10)) # train set
  test <- tail(res.unlist, length(res.unlist) - length(train)) # test set
  nfuture <- forecast(train, # forecast
                      model = auto.arima(train), 
                      lambda = 0, biasadj = TRUE, h = length(test))$mean    
  ### metric ####
  RMSE <- rmse(test, nfuture) # return RMSE
  return(
    list("RMSE" = RMSE)
  )
}

когда я передал это:

set.seed(123, kind = "L'Ecuyer-CMRG")
MC_result <- MonteCarlo(func = function2, 
                            nrep = reps,
                            ncpus = parallel::detectCores() - 1,
                            param_list = param_list,
                            export_also = list(
                              "packages" = c("forecast", "Metrics")
                            ),
                            raw = T)

Я получил это сообщение об ошибке:

3 узла выдали ошибки; первая ошибка: не удалось найти функцию vblocks

В своем испытании я просто поместил все function1 как одно выражение в function2


person Daniel James    schedule 20.10.2020    source источник
comment
Жду помощи по этому вопросу.   -  person Daniel James    schedule 21.10.2020
comment
Если кому-то нужны дополнительные разъяснения по этой проблеме, спросите меня через строку комментариев.   -  person Daniel James    schedule 21.10.2020


Ответы (1)


Вы можете поместить содержимое function1 в тело function2, включая назначения переменных и т. Д.

library(MonteCarlo)
library(forecast)
library(ModelMetrics)

mc_f <- function(n, lb, phi) {
  # Generate data
  ov <- ceiling(lb / 2)
  starts <- unique(sort(c(seq(1, n, lb), seq(lb - ov + 1, n, lb))))
  ends <- pmin(starts + lb - 1, n)
  num <- match(n, ends)
  d <- head(data.frame(starts, ends), num)
  
  ts <- arima.sim(n, model = list(ar = phi, order = c(1, 0, 0)), sd = 1)
  
  blk <- mapply(
    function(start, end) ts[start:end],
    d$starts, 
    d$ends, 
    SIMPLIFY = FALSE
  )
  
  # Resample
  res <- sample(blk, replace = TRUE, 10)
  res.unlist <- unlist(res, use.names = FALSE)
  
  # Train and forecast
  train <- head(res.unlist, round(length(res.unlist) - 10))
  test <- tail(res.unlist, length(res.unlist) - length(train))
  nfuture <- forecast(train,
                      model = auto.arima(train),
                      lambda = 0, biasadj = TRUE, h = length(test))$mean
  
  # Extract metric
  RMSE <- rmse(test, nfuture)
  list("RMSE" = RMSE)
}
reps <- 3
param_list <- list(n = 10, lb = seq(n - 2) + 1, phi = 0.6)

mc_result <- MonteCarlo(
  func = mc_f,
  nrep = reps,
  ncpus = parallel::detectCores() - 1,
  param_list = param_list
)
#> Grid of  8  parameter constellations to be evaluated. 
#>  
#> Simulation parallelized using 3 cpus. 
#>  
#> Progress: 
#>  
#>   |==================================================================================| 100%
person Paul    schedule 21.10.2020