带有 purrr 的嵌套映射函数答案

【问题标题】：nested map functions with purrr带有 purrr 的嵌套映射函数
【发布时间】：2019-12-27 21:48:12
【问题描述】：

我需要使用引导程序执行 knn 回归，并针对不同的 K 值进行迭代

假设我有 2 个数据框，训练和测试

train <- read.csv("train.csv")
test <- read.csv("test.csv")

还有一个函数knn，看起来像：

knn <- function(train_data, train_label, test_data, K){

  len_train <- nrow(train_data)
  len_test <- nrow(test_data)


  test_label <- rep(0, len_test)

  k_means <- function(training_pt){

    distances <- as.matrix(dist(rbind(training_pt, train_data)))[1, (1+1):(1+len_train)]
    data.frame(y = train_label) %>%
    # train_label %>%
      mutate(pt_dist = distances) %>%
      arrange(pt_dist) %>%
      select(y) %>%
      slice(1:K) %>% pull() %>% mean()
  }

  predictions <- apply(test_data, 1, k_means)
  return(predictions)

}

其中 train_data 采用带有预测列的数据框， train_label 是训练值的向量，并且 test_data 是一个数据框，其列与 train_data 相似

该函数返回test_data每一行的预测测试标签

现在，我编写了一个函数来生成引导样本：

gen_boot_sample <- function(df, sample_size = 25){
  df %>% sample_n(sample_size, replace = T)
}

我设法编写了一些东西，将knn 函数应用于生成的引导样本，以获得固定的 K 值。

但是我正在努力迭代 K

这个想法是生成一个数据帧，其中包含每个 K 值的每个引导样本（比如 20 个样本）的误差值

test_label <- test_data %>%
  select_at(.vars = vars(contains("y"))) %>%
  pull()

rerun(5, gen_boot_sample(train_data)) %>%
      map( ~ knn( 
      train_data = .x %>%
        select_at(.vars = vars(contains("x"))),
      train_label = .x %>%
        select_at(.vars = vars(contains("y"))) %>%
        pull(),
      test_data = test_data %>%
        select_at(.vars = vars(contains("x"))),
      K = 5
         )
      ) %>%
      map(~sum(. - test_label)^2)

我检查了答案 purrr map equivalent of nested for loop 但考虑到我的knn 函数如何接受参数，我正在苦苦挣扎

编辑：添加部分数据

train_data <- structure(list(x1 = c(1973.5, 1967.5, 1970.5, 1978, 1964, 1962, 
1980, 1961.5, 1976.5, 1979.5), y = c(6.57, 1.83, 3.69, 11.88, 
0.92, 0.72, 16.2, 0.92, 8.28, 14.85)), row.names = c(28L, 16L, 
22L, 37L, 9L, 5L, 41L, 4L, 34L, 40L), class = "data.frame")

test_data <- structure(list(x1 = c(1978.75, 1962.75, 1974.25, 1975.75, 1963.75, 
1972.75, 1968.25, 1980.75, 1979.25, 1970.75), y = c(8.91, 0.6, 
6.39, 6.12, 0.77, 4.41, 2.07, 11.61, 12.96, 3.6)), row.names = c(38L, 
6L, 29L, 32L, 8L, 26L, 17L, 42L, 39L, 22L), class = "data.frame")

【问题讨论】：

对不起，p2_train/test 是 train_data 和 test_data。编辑了帖子
我已经为我的 knn 函数的实现添加了示例数据和代码
你删除了train_labelknn(train_data, train_label, test_data, K = 5) Error in eval_tidy(xs[[i]], unique_output) : object 'train_label' not found
你需要rerun(5, gen_boot_sample(train_data)) %>% map(~ {train_data <- .x %>% select_at(vars(contains('x'))); train_label = .x %>% select_at(.vars = vars(contains("y"))) %>% pull(); test_data = test_data %>% select_at(.vars = vars(contains("x"))); map_dbl(1:10, ~ {out <- knn(train_data, train_label, test_data, K = .x); sum(out - test_label)^2})})
这对于 x 变量是有意义的，尽管这些变量也可以使用 select(.x, contains("x")) 进行简化

标签： r dplyr purrr

【解决方案1】：

我们可以使用另一个嵌套在map 中的循环来运行不同的“K”值

library(tidyverse)
rerun(5, gen_boot_sample(train_data)) %>%
      map(~ {
         # create the subset datasets
         train_data <- .x %>%
                           select_at(vars(contains('x')))
         train_label <- .x %>%
                          select_at(.vars = vars(contains("y"))) %>% 
                          pull()
         test_data <- test_data %>% 
                         select_at(.vars = vars(contains("x")))
        # loop over different values for 'K'
        map_dbl(1:10, ~ {
               #apply the knn function
               out <- knn(train_data, train_label, test_data, K = .x)
               sum(out - test_label)^2}
             )
      })

【讨论】：