Question

如何用purrr函数替换for循环？ straightforward有很多情况，但是在这种情况下，我正在尝试在循环期间进行分配。词法作用域用于查找要修改的对象，但不会保存进度。好像修改仅在每次迭代时发生，然后被丢弃。

结果应为更新的矩阵dead_yes和dead_no。

经过编辑以使用pwalk（）强调副作用，而不是基于@hadley的注释进行输出。我们不希望任何东西退回；相反，我们只是在修改现有变量。

library(tidyverse)
library(faraway)
data(femsmoke)

dead_yes <- matrix(NA, nrow = length(unique(femsmoke$smoker)), ncol = length(unique(femsmoke$age)))
dead_no <- matrix(NA, nrow = length(unique(femsmoke$smoker)), ncol = length(unique(femsmoke$age)))

colnames(dead_yes) <- colnames(dead_no) <- unique(femsmoke$age)
rownames(dead_yes) <- rownames(dead_no) <- unique(femsmoke$smoker)

w <- unique(femsmoke$age)
v <- unique(femsmoke$smoker)
u <- unique(femsmoke$dead)

pwalk(list(
  row = match(femsmoke$smoker, v),
  col = match(femsmoke$age, w),
  y = femsmoke$y,
  dead = femsmoke$dead
), function(row, col, y, dead) {
  if (dead == "yes") {
    dead_yes[row, col] <- y
  } else {
    dead_no[row, col] <- y
  }
})

由reprex package（v0.2.0）于2018-09-29创建。

Answer 1

如果您确实想在全局环境中更改x对象，则可以需要在迭代机内部使用<<-进行分配（对于 [lv]apply()或purrr::map()）。通用示例：

(x <- rep(NA_integer_, 3))
#> [1] NA NA NA

purrr::map_dbl(1:3, function(i) x[[i]] <- -i)
#> [1] -1 -2 -3
x
#> [1] NA NA NA

vapply(1:3, function(i) x[[i]] <- -i, integer(1))
#> [1] -1 -2 -3
x
#> [1] NA NA NA

purrr::map_dbl(1:3, function(i) x[[i]] <<- -i)
#> [1] -1 -2 -3
x
#> [1] -1 -2 -3

vapply(1:3, function(i) x[[i]] <<- -2L * i, integer(1))
#> [1] -2 -4 -6
x
#> [1] -2 -4 -6

在父环境中修改对象确实违反了但是，这些功能的功能性质。通常，当您必须使用<<-时，通常意味着有另一种解决方法。在这种情况下，数据重塑似乎是考虑原始任务的另一种方式。

但是，要回答原始问题，请使用<<-作为原始问题代码“工作”。我切换到purrr::pwalk()来强调副作用，并且也将dead从因素转换为字符。

library(tidyverse)
library(faraway)
data(femsmoke)

dead_yes <- matrix(NA, nrow = length(unique(femsmoke$smoker)), ncol = length(unique(femsmoke$age)))
dead_no <- matrix(NA, nrow = length(unique(femsmoke$smoker)), ncol = length(unique(femsmoke$age)))

colnames(dead_yes) <- colnames(dead_no) <- unique(femsmoke$age)
rownames(dead_yes) <- rownames(dead_no) <- unique(femsmoke$smoker)

w <- unique(femsmoke$age)
v <- unique(femsmoke$smoker)
u <- unique(femsmoke$dead)

pwalk(list(
  row = match(femsmoke$smoker, v),
  col = match(femsmoke$age, w),
  y = femsmoke$y,
  dead = as.character(femsmoke$dead)
), function(row, col, y, dead) {
  if (dead == "yes") {
    dead_yes[row, col] <<- y
  } else {
    dead_no[row, col] <<- y
  }
})
dead_yes
#>     18-24 25-34 35-44 45-54 55-64 65-74 75+
#> yes     2     3    14    27    51    29  13
#> no      1     5     7    12    40   101  64
dead_no
#>     18-24 25-34 35-44 45-54 55-64 65-74 75+
#> yes    53   121    95   103    64     7   0
#> no     61   152   114    66    81    28   0

^{由reprex package（v0.2.1）于2018-09-29创建}

使用purrr函数进行全局分配

1 个答案: