Соберите используя имена строк - PullRequest
Новая
       15

Соберите используя имена строк

0 голосов
/ 07 июня 2018

Я прогнозирую данные временных рядов (в которых используются имена строк) и хотел бы объединить некоторые показатели точности в один фрейм данных, различая при этом методы.В качестве примера: 

library(fpp2)
beer.train <- window(beer, end = c(1994, 12))
beer.test <- window(beer, start = 1995)
AccMean <- accuracy(meanf(beer.train, h = 8), beer.test)
AccRW <- accuracy(rwf(beer.train, h = 8), beer.test)
rbind(AccMean, AccRW)
#                         ME     RMSE      MAE         MPE     MAPE     MASE       ACF1 Theil's U
# Training set -9.474373e-15 19.82001 15.97396  -1.6202496 10.42125 1.726914  0.4628439        NA
# Test set     -1.289583e+01 17.57100 13.57292 -10.1596449 10.60310 1.467342 -0.4904015 0.7998411
# Training set  3.829787e-01 20.18004 15.14894  -0.6398801 10.05885 1.637723 -0.1547700        NA
# Test set     -4.375000e+01 45.34865 43.75000 -32.6470928 32.64709 4.729730 -0.4904015 2.0312792

Тем не менее, я хотел бы видеть вывод как: 

# Method   Set            ME     RMSE      MAE         MPE     MAPE     MASE       ACF1 Theil's U
#   Mean Train -9.474373e-15 19.82001 15.97396  -1.6202496 10.42125 1.726914  0.4628439        NA
#   Mean  Test -1.289583e+01 17.57100 13.57292 -10.1596449 10.60310 1.467342 -0.4904015 0.7998411
#     RW Train  3.829787e-01 20.18004 15.14894  -0.6398801 10.05885 1.637723 -0.1547700        NA
#     RW  Test -4.375000e+01 45.34865 43.75000 -32.6470928 32.64709 4.729730 -0.4904015 2.0312792

Одним из способов было бы сделать следующее: 

AccMean <- AccMean %>% as.data.frame() %>% mutate(Method = "Mean", Set = c("Train", "Test")) %>% select(Method, Set, everything())
AccRW <- AccRW %>% as.data.frame() %>% mutate(Method = "RW", Set = c("Train", "Test")) %>% select(Method, Set, everything())
rbind(AccRW, AccMean)
#   Method   Set            ME     RMSE      MAE         MPE     MAPE     MASE       ACF1 Theil's U
# 1   Mean Train -9.474373e-15 19.82001 15.97396  -1.6202496 10.42125 1.726914  0.4628439        NA
# 2   Mean  Test -1.289583e+01 17.57100 13.57292 -10.1596449 10.60310 1.467342 -0.4904015 0.7998411
# 3     RW Train  3.829787e-01 20.18004 15.14894  -0.6398801 10.05885 1.637723 -0.1547700        NA
# 4     RW  Test -4.375000e+01 45.34865 43.75000 -32.6470928 32.64709 4.729730 -0.4904015 2.0312792

однако я хотел бы обобщить это для n методов, и вышеприведенное было бы утомительно для больших n.Я думаю, что было бы полезно использовать gather(), но я не могу заставить его работать с row.names.

Обратите внимание, что этот связанный вопрос не отвечает на мой.

1 Ответ

0 голосов
/ 07 июня 2018

Это легко сделать с помощью функции purrr imap.

Первый трюк состоит в том, чтобы предварительно определить все методы теста функции и пометить их: 

# define and label test methods
test_methods <- list(
  Mean = meanf,
  RW = rwf
)

Затем мы позволяем imap_dfr делать забавные вещи - применять каждую функцию к данным, переформатировать их, маркировать и связывать все вместе 

library(purrr)
result_df <- imap_dfr(test_methods, function(f, .method) {
  tmp <- accuracy(f(beer.train, h = 8), beer.test) 
  tmp %>%
    as.data.frame() %>%
    mutate(
      Set = str_extract(rownames(tmp), "Train|Test"),
      Method = .method
    ) %>% 
    select(Method, Set, everything())
})

Мы используем imap потому что он автоматически устанавливает 2-ю переменную в функции (здесь .method) на имена в нашем списке (например, имена в test_methods).Это именно то, что нужно здесь.

Обновление

Чтобы добавить аргументы к вызовам функций, нам нужно включить эту информацию в методы тестирования.Например: 

test_methods <- list(
  Mean = meanf,
  RW = rwf,
  RWdrift = function(x, ...) rwf(x, drift = TRUE, ...)
)

Точечная запись необходима, потому что h=8 жестко запрограммирован в вызовах функций.Если h также изменяется, вам необходимо удалить его из вызова в пределах imap_dfr и указать его во всех test_methods записях: 

test_methods <- list(
  Mean08 = function(x) meanf(x, h = 8),
  Mean10 = function(x) meanf(x, h = 10),
  RW8 = function(x) rwf(x, h = 8,
  RWdrift8 = function(x, ...) rwf(x, h = 8, drift = TRUE, ...)
)
...