R语言 用引用嵌套列、非嵌套列和嵌套列表中的数据的函数Map许多模型

64jmpszr  于 2023-02-26  发布在  其他
关注(0)|答案(1)|浏览(128)

我尝试通过应用可分类为以下几类的函数来对嵌套模型进行分析:
1.引用函数中参数固定的嵌套列中的数据
1.引用嵌套列中的数据,参数作为列出列动态引用
1.引用嵌套列中的数据,参数在未列出的列中动态引用
1.引用带有直接引用的参数的嵌套列中的数据
求助:
1.我无法使make_data_input公式工作,无论其嵌套数据还是非嵌套数据
1.我根本无法在嵌套数据集中得到make_data_input公式

library(tidyverse)

#This work 

make_data_fixed <- function(df) {

  df %>% 
    mutate(price_cumsum=cumsum(price),
           max_price_cumsum=max(price_cumsum))
}

# the max column is not calculating the max column of price but instead pulling the prie_cumsum column values it pulls in the literal value
make_data_input <- function(df,x) {
  df %>% 
    mutate("{{x}}_cumsum":=cumsum({{x}}),
           "max_{{x}}_cumsum":=max("{{x}}_cumsum")
           )
}

selected_cols <- c("clarity","depth")

calculate_stuff <- function(df,x) {
  df %>% 
    summarize(across({x},
                    ~length(
                      unique(.)
                      )
                    )
              )
}

calculate_stuff(diamonds,selected_cols)


diamonds %>% 
  group_by(cut,color) %>% 
  nest() %>%
  mutate(test=list(selected_cols),
         carat="carat") %>% 
  mutate(simple=map(data,make_data_fixed),# this works
         calculate_direct=map2(.x=data,.y=test,~calculate_stuff(df=.x,x=.y)), # this works
         calculate_indirect=map2(.x=data,.y=carat,~calculate_stuff(df=.x,x=.y)), # this works
         complex=map2(.x=data,.y=price,~make_data_input(df=.x,.y=price)) # this doesn't work
         )
qxgroojn

qxgroojn1#

我会做两件事。首先,使用dplyr::rowwise()而不是purrr::map,这使得代码更容易阅读和推理。也更容易理解函数中包含哪些对象名。
其次,我们需要更正make_data_input。您使用max("{{x}}_cumsum"),但"{{x}}_cumsum"仅仅是一个字符串。我们需要首先基于"{{x}}_cumsum"创建一个字符串,我们使用rlang::englue()完成此操作,然后可以在.data[[]]!! sym()中使用此字符串。

library(tidyverse)

make_data_fixed <- function(df) {
  
  df %>% 
    mutate(price_cumsum=cumsum(price),
           max_price_cumsum=max(price_cumsum))
}

make_data_input <- function(df, x) {
  df %>%
    mutate("{{x}}_cumsum" := cumsum({{x}}),
           "max_{{x}}_cumsum" := max(.data[[rlang::englue("{{x}}_cumsum")]])
    )
}

selected_cols <- c("clarity","depth")

calculate_stuff <- function(df,x) {
  df %>% 
    summarize(across({x},
                     ~length(
                       unique(.)
                     )
    )
    )
}

diamonds %>% 
  group_by(cut,color) %>% 
  nest() %>%
  mutate(test=list(selected_cols),
         carat="carat") %>% 
  rowwise() %>% 
  mutate(simple = list(make_data_fixed(data)),
         calculate_direct = list(calculate_stuff(data, test)), 
         calculate_indirect = list(calculate_stuff(data, carat)), 
         complex = list(make_data_input(data, price)) 
  ) %>% 
  pull(complex) %>% 
  .[[1]]

#> # A tibble: 3,903 x 10
#>    carat clarity depth table price     x     y     z price_cumsum
#>    <dbl> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>        <int>
#>  1  0.23 SI2      61.5    55   326  3.95  3.98  2.43          326
#>  2  0.26 VVS2     62.9    58   554  4.02  4.06  2.54          880
#>  3  0.7  SI1      62.5    57  2757  5.7   5.72  3.57         3637
#>  4  0.59 VVS2     62      55  2761  5.38  5.43  3.35         6398
#>  5  0.74 SI2      62.2    56  2761  5.8   5.84  3.62         9159
#>  6  0.7  VS2      60.7    58  2762  5.73  5.76  3.49        11921
#>  7  0.74 SI1      62.3    54  2762  5.8   5.83  3.62        14683
#>  8  0.7  SI1      60.9    57  2768  5.73  5.76  3.5         17451
#>  9  0.6  VS1      61.7    55  2774  5.41  5.44  3.35        20225
#> 10  0.7  SI1      62.7    55  2774  5.68  5.74  3.58        22999
#> # ... with 3,893 more rows, and 1 more variable: max_price_cumsum <int>

reprex package(v2.0.1)于2023年2月22日创建

相关问题