当我尝试在 dplyr group_map 函数中使用 defuse-inject 模式时失败

Question

以下是我想要实现的一个例子。

library(dplyr)

tbl.data <- tidyquant::tq_get(c("GS", "C", "BAC"))

to.xts <- function(group, group_key, date_col, price_col){
  a <- group %>% dplyr::pull({{ price_col }}) 
  b <- group %>% dplyr::pull({{ date_col }})
  x <- xts::xts(a, order.by=b)
  colnames(x) <- key$symbol
  x
}

make.xts <- function(data, date_col, price_col){
  data %>% 
   group_by(symbol) %>%
   group_map(~to.xts(.x, .y, date_col, price_col))
}

# Failed example one:
tbl.data %>% group_by(symbol) %>% group_map(to.xts, date, close)

# Failed example two:
make.xts(tbl.data, date, close)

# Error in `dplyr::pull()`:
# ! Can't extract column with `!!enquo(var)`.
# ✖ `!!enquo(var)` must be numeric or character, not a function.
# Run `rlang::last_error()` to see where the error occurred.

# However, If I single out a group myself and apply `to.xts` to that group it'll work. The only thing changed, which I doubt that it would have effect on the function itself, is that the `group_key` is now a string (it was a data-variable in the context of `group_map`'s `.f`)

gs.grp <- tbl.data %>% dplyr::filter(symbol=="GS")
gs.grp %>% to.xts("GS", date, col)
 
# A simply pull operation would also work.

gs.grp %>% dplyr::pull(close)

不太明白内部发生了什么变化；为什么会这样，这里有什么不正确的地方？

鉴于错误信息似乎

dplyr::pull

正在做 化解 (

enquo

) 并在内部注入 (

!!

) 本身，因此我不会使用拥抱运算符；但是，如果没有它，它也不起作用并导致同样的错误。

Answer 1

我没怎么用过

group_map

功能，这里有一个替代版本，你可以试试-

library(dplyr)
library(purrr)

tbl.data <- tidyquant::tq_get(c("GS", "C", "BAC"))

to.xts <- function(group, symbol, date, price){
  a <- group %>% dplyr::pull({{ price }}) 
  b <- group %>% dplyr::pull({{ date }})
  x <- xts::xts(a, order.by=b)
  colnames(x) <- symbol
  x
}

tbl.data %>% split(.$symbol) %>% imap(~to.xts(.x, .y, date, close))

如果你想让它们在一个

xts

对象中作为单独的列。

tbl.data %>% 
  split(.$symbol) %>% 
  imap(~to.xts(.x, .y, date, close)) %>%
  {do.call(merge, .)} 

#             BAC     C     GS
#2013-01-02 12.03 41.25 131.66
#2013-01-03 11.96 41.39 130.94
#2013-01-04 12.11 42.43 134.51
#2013-01-07 12.09 42.47 134.26
#2013-01-08 11.98 42.46 133.05
#2013-01-09 11.43 42.04 134.32

Answer 2

使用

group_map

使用公式应用于每个组：

library(dplyr)
#library(xts)

tbl.data %>%
  group_by(symbol) %>% 
  group_map(~ to.xts(.x, .y, date, close))

to.xts <- function(group, group_key, date, price) {
  a <- group %>% dplyr::pull({{ price }}) 
  b <- group %>% dplyr::pull({{ date }})
  x <- xts::xts(a, order.by = b)
  colnames(x) <- group_key
  x
}

与它所基于的

purr

非常相似。

公式中，可以用

.或 .x 引用给定组的 .tbl 行的子集

.y 指的是键，一行一行，每个分组变量一列，用于标识组

（见文档）

或者，我们也可以使用旋转来避免您的功能，并将其放在一个

xts

-对象中。

library(dplyr)
library(tidyr)
#library(xts)

tbl.data %>% 
  pivot_wider(date, names_from = symbol, values_from = low) %>%
  xts::xts(order.by = .$date) %>%
  .[,-1]

输出：

           GS    C      BAC   
2013-01-02 "130" "40.7" "11.9"
2013-01-03 "130" "41.0" "11.9"
2013-01-04 "130" "41.6" "11.9"
2013-01-07 "133" "42.0" "12.0"
2013-01-08 "133" "42.0" "11.9"
2013-01-09 "133" "41.8" "11.3"
2013-01-10 "134" "42.0" "11.5"

Answer 3

这并没有回答你的问题，但我想指出，如果你完全避免 tidyverse 模式，这就不那么复杂了。

symbols <- c("GS", "C", "BAC")

# Environment to hold data
my_data <- new.env()

# Tell getSymbols() to load the data into 'my_data'
getSymbols(symbols, env = my_data)

# Combine all the close prices into one xts object
price_data <- Reduce(merge, lapply(my_data, Cl))

# Remove ".Close" from column names
colnames(price_data) <- sub(".Close", "", colnames(price_data), fixed = TRUE)