Векторизация с помощью lapply вместо использования цикла For - PullRequest
Новая
       10

Векторизация с помощью lapply вместо использования цикла For

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

Я пытаюсь уйти от циклов в R и хотел как векторизовать, так и ускорить раздел моего кода.

Я хочу преобразовать цикл For, используя lapply, но получаю ошибку: enter image description here

Воспроизводимый пример: 

library(dplyr)

# This works using a For loop -----------------------------------

# create sample data frame
df <- data.frame(Date  = rep(c("Jan1", "Jan2", "Jan3"), 3),
                 Item  = c(rep("A", 3), rep("B", 3), rep("C", 3)),
                 Value = 10:18)


diff <- numeric() # initialize

# Loop through each item and take difference of latest value from earlier values
for (myitem in unique(df$Item)) {

    y = df[df$Date == last(df$Date) & df$Item == myitem, "Value"]  # Latest value for an item

    x = df[df$Item == myitem, "Value"]                             # Every value for an item

    diff <- c(diff, y-x)

}

df_final <- mutate(df, Difference = diff)
df_final

enter image description here

Я нашел похожие вопросы здесь (радостно) , здесь (радостно) и здесь ($ operator) , но никто не помог мне с моим вопросом.

Вот как я пытался векторизовать с помощью lapply: 

# Same thing using vectorized approach ----------------------------------

mylist <- list(unique(df$Item))

myfunction <- function(df = df, diff = numeric()) {

    y = df[df$Date == last(df$Date) & df$Item == mylist, "Value"]  # Latest value for an item

    x = df[df$Item == mylist, "Value"]                             # Every value for an item

    diff <- c(diff, y-x)

}

# throws error
diff_vector <- unlist(lapply(mylist, myfunction))

df_final2 <- mutate(df, Difference = diff_vector)
df_final2

Мой реальный набор данных состоит из сотен тысяч строк. Если бы кто-то мог указать мне правильное направление на то, как векторизовать это, чтобы получить тот же результат, что и в цикле For, я был бы признателен.

Спасибо!

Ответы [ 3 ]

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

вы можете создать таблицу с самым последним значением, объединить с исходной таблицей и получить разницу или использовать data.table, чтобы создать дополнительный столбец с последним значением 

library(data.table)
df <- data.frame(Date  = rep(c("Jan1", "Jan2", "Jan3"), 3),
                 Item  = c(rep("A", 3), rep("B", 3), rep("C", 3)),
                 Value = 10:18)

setDT(df)

df[,latestVal:=last(Value),by=.(Item)][,diff:=latestVal-Value][,.(Date,Item,Value,diff)]
0 голосов
/ 27 июня 2018

Так что lapply не используется здесь, вот и все!

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

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

Мы можем сделать это, используя функцию разделения, она разбивает ваш фрейм данных на несколько фреймов данных на основе столбца и сохраняет их в виде списка. Список подмножеств фрейма данных. Отлично!

Итак, давайте заменим строку, в которой вы создаете mylist, этой строкой. 

mylist <- split(df,df[,c("Item")])

Теперь нам просто нужно внести некоторые изменения в myfunction. Помните, что мы сейчас передаем наши данные, уже поднастроенные, поэтому мы можем убрать условия о Item совпадении с тем, что мы ожидаем. Помните, что эта функция будет применена к каждому из этих фреймов данных в полном объеме. 

myfunction <- function(df = df, diff = numeric()) { 
    y = df[df$Date == last(df$Date), "Value"]  # Latest value for an item

    x = df[, "Value"]                             # Every value for an item

    diff <- c(diff, y-x)
}

А остальное, друг мой, именно такой, как у тебя:)

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

Я не уверен, lapply правильный подход. Я бы придерживался mutate - который вы, похоже, уже используете: 

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
df <- data.frame(Date  = rep(c("Jan1", "Jan2", "Jan3"), 3),
  Item  = c(rep("A", 3), rep("B", 3), rep("C", 3)),
  Value = 10:18)

df <- df %>%
  group_by(Item) %>%
  mutate(diff = last(Value) - Value)

df
#> # A tibble: 9 x 4
#> # Groups:   Item [3]
#>   Date  Item  Value  diff
#>   <fct> <fct> <int> <int>
#> 1 Jan1  A        10     2
#> 2 Jan2  A        11     1
#> 3 Jan3  A        12     0
#> 4 Jan1  B        13     2
#> 5 Jan2  B        14     1
#> 6 Jan3  B        15     0
#> 7 Jan1  C        16     2
#> 8 Jan2  C        17     1
#> 9 Jan3  C        18     0

Создано в 2018-06-27 пакетом представ. (v0.2.0).

Это предполагает, что наблюдения (по крайней мере, внутри группы «Предмет») расположены в порядке. Если нет, добавьте arrange(Date) %>% в качестве шага после group_by

...