Глобальное назначение с использованием функций purrr

Question

Как заменить цикл for функциями purrr?Есть много случаев, которые прямолинейны , но в этом случае я пытаюсь выполнить назначение во время цикла.Лексическая область видимости используется для поиска изменяемого объекта, но не сохраняет прогресс.Как будто модификация происходит только на каждой итерации, а затем отбрасывается.

В результате должны быть обновлены матрицы 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
  }
})

Создано в 2018-09-29 пакетом представлением (v0.2.0).

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

^{Создан в 2018-09-29 пакетом Представить (v0.2.1)}