簡體   English   中英

purrr + dplyr NSE 問題在用戶內部編寫 function

[英]purrr + dplyr NSE issues inside a user written function

經過大量的試驗和錯誤並咨詢了以前的答案,例如如何檢測裸變量或字符串,我認為我已經完成了我需要自己完成的大部分工作。 但是我很想知道在我將“解決方案”投入生產之前,我是否做出了一些錯誤的假設或愚蠢地解決了這個問題。

考慮以下數據:

library(dplyr)
library(purrr)
library(tidyselect)

set.seed(1111)
dat1 <- data.frame(Region = rep(c("r1","r2"), each = 100),
                   State = rep(c("NY","MA","FL","GA"), each = 10),
                   Loc = rep(c("a","b","c","d","e","f","g","h"),each = 5),
                   ID = rep(c(1:10), each = 2),
                   var1 = rnorm(200),
                   var2 = rnorm(200),
                   var3 = rnorm(200),
                   var4 = rnorm(200),
                   var5 = rnorm(200))

我想寫一個 function 做很多事情,但我將從一個最小的可重現示例開始。 我想為單個案例var1 ~ State或使用map2的一對匹配列表返回tidied aov結果,其中一個列表包含“結果”和其他“預測變量” 它們從使用到使用從不完全相同,並且與我的示例不同,變量很少適合像starts_with這樣的簡單解決方案。

兩個具體問題和一個一般性問題。

問題 #1 - 我已經放棄允許最終用戶(包括我)傳入裸變量名,這總是讓我以后遇到麻煩。 按照上面的參考是不是像我的代碼最快最可靠的方法來捕捉它們並告訴用戶? (我在代碼中添加了注釋以表明我在說什么。

問題 #2 - 通過基本上跟蹤和錯誤,我想我解決了我的另一個問題,即生成一些文本以供以后用作 label。 當我不將 function 與map2一起使用時,我找到了很多解決方案,但似乎只有這個與 map2 一起使用。 看起來很復雜,我簡直不敢相信這是一個不錯的選擇......(再次在代碼中注釋以顯示位置)

一般問題:我添加了推薦的tidyselect::all_of因為這些可能是模棱兩可的列表,為什么我仍然必須防止.x.y被視為調用而不是迭代標記?

MyFunction <- function(data,
                 groupvar,
                 var) {
  # Issue #1 is this best way to warn/stop user?
  lst <- as.list(match.call())

  if (is.symbol(lst$groupvar) || is.symbol(lst$var)) {
    stop("Please quote all variables")
  }

  # Issue #2 I want the group label but if I don't include
  # this if logic it errors with " Error: Can't convert a call to a string"
  # when I run it with purrr::map2
  if (!is.call(groupvar)) {
     grouplabel <- rlang::as_name(rlang::enquo(groupvar))
  }

  data <-
    dplyr::select(
      .data = data,
      var = {{ var }},
      groupvar = {{ groupvar }}
    )

  aov_object <- aov(var ~ groupvar, data = data)
  aov_results <- broom::tidy(aov_object) %>%
    mutate(term = if_else(term != "Residuals", grouplabel, term))
  return(aov_results)
}

# Expected output

MyFunction(data = dat1, groupvar = "State", var = "var1") # works
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 State         3   1.75  0.582     0.485   0.693
#> 2 Residuals   196 235.    1.20     NA      NA

MyFunction(data = dat1, groupvar = State, var = var1) # warns appropriately
#> Error in MyFunction(data = dat1, groupvar = State, var = var1): Please quote all variables

# Quick test of `map2`
grouping_vars <- names(dat1[,1:3])
names(grouping_vars) <- names(dat1[,1:3])

outcome_vars <- names(dat1[,5:7])
names(outcome_vars) <- names(dat1[,5:7])

names(outcome_vars) <- paste(outcome_vars, "~", grouping_vars)

# get multiple results this is where issue #2 comes in but this is what I want it to look like.

map2(.x = outcome_vars,
     .y = grouping_vars,
     .f = ~ MyFunction(dat = dat1,
                 var = tidyselect::all_of(.x),
                 groupvar = tidyselect::all_of(.y)))
#> $`var1 ~ Region`
#> # A tibble: 2 x 6
#>   term         df    sumsq meansq statistic p.value
#>   <chr>     <dbl>    <dbl>  <dbl>     <dbl>   <dbl>
#> 1 Region        1   0.0512 0.0512    0.0427   0.836
#> 2 Residuals   198 237.     1.20     NA       NA    
#> 
#> $`var2 ~ State`
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 State         3   5.05  1.68       2.07   0.106
#> 2 Residuals   196 159.    0.814     NA     NA    
#> 
#> $`var3 ~ Loc`
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 Loc           7   5.09  0.727     0.772   0.612
#> 2 Residuals   192 181.    0.943    NA      NA

在我看來,由於您堅持將字符串作為變量名傳遞,因此使用as.formula更改公式以匹配變量而不是更改數據會更簡單、更有效。 這也避免了您必須單獨命名 function 中的分組變量。

下面的 function 在基准測試中比原來的更短,速度大約是原來的兩倍,但行為保持不變:

MyFunctionNew <- function(data, groupvar, var) 
{  
  lst <- as.list(match.call())
  if (is.symbol(lst$groupvar) || is.symbol(lst$var)) 
    stop("Please quote all variables")

  broom::tidy(aov(as.formula(paste(var, "~", groupvar)), data = data)) %>%
    mutate(term = if_else(term != "Residuals", groupvar, term))
}

您可以看到它在map2中仍然有效:

map2(.x = outcome_vars,
     .y = grouping_vars,
     .f = ~ MyFunctionNew(dat = dat1,
                       var = tidyselect::all_of(.x),
                       groupvar = tidyselect::all_of(.y)))
#> $`var1 ~ Region`
#> # A tibble: 2 x 6
#>   term         df    sumsq meansq statistic p.value
#>   <chr>     <dbl>    <dbl>  <dbl>     <dbl>   <dbl>
#> 1 Region        1   0.0512 0.0512    0.0427   0.836
#> 2 Residuals   198 237.     1.20     NA       NA    
#> 
#> $`var2 ~ State`
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 State         3   5.05  1.68       2.07   0.106
#> 2 Residuals   196 159.    0.814     NA     NA    
#> 
#> $`var3 ~ Loc`
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 Loc           7   5.09  0.727     0.772   0.612
#> 2 Residuals   192 181.    0.943    NA      NA    

在篩選變量以確保它們是字符串方面,我不認為這是慣用的 R 用法,並且可能會給 function 的普通用戶造成一些混淆。 換句話說,它違反了 最小驚訝原則

例如,作為一個天真的用戶,我希望能夠像這樣以編程方式指定分組變量:

MyVar <- "State"
MyFunction(data = dat1, groupvar = MyVar, var = "var1")

但是,我收到一條錯誤消息,告訴我應該引用所有變量。

這也意味着您的 function 將無法在基本 R 循環和*apply函數中工作:

lapply(c("State", "Region", "ID"), function(x) MyFunction(dat1, x, "var1"))
#> Error in MyFunction(dat1, x, "var1") : Please quote all variables 

我認為這比僅在使用未加引號的列名時允許引發錯誤更令人困惑和限制。 因此,我認為您的生產 function 應該是這樣的:

MyFunction <- function(data, groupvar, var) 
{  
  broom::tidy(aov(as.formula(paste(var, "~", groupvar)), data = data)) %>%
    mutate(term = if_else(term != "Residuals", groupvar, term))
}

執行如下:

MyFunction(data = dat1, groupvar = "State", var = "var1") 
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 State         3   1.75  0.582     0.485   0.693
#> 2 Residuals   196 235.    1.20     NA      NA    

MyFunction(data = dat1, groupvar = MyVar, var = "var1")
#> # A tibble: 2 x 6
#>   term         df  sumsq meansq statistic p.value
#>   <chr>     <dbl>  <dbl>  <dbl>     <dbl>   <dbl>
#> 1 State         3   1.75  0.582     0.485   0.693
#> 2 Residuals   196 235.    1.20     NA      NA    

MyFunction(data = dat1, groupvar = State, var = var1) 
#>  Error in paste(var, "~", groupvar) : object 'State' not found 

我認為大多數 R 用戶會意識到他們為什么會收到最后一個錯誤,因為它很清楚。 這也是普通 R 用戶會看到很多次的錯誤。 如果您對您的用戶不太信任,也許您可以嘗試將 function 主體包裝在tryCatch中,將“未找到符號錯誤”轉換為“請使用引號”錯誤。

最終,最好編寫 function 以便它采用裸符號,但我的印象是你很想避免這種情況,所以我不會在這里強調這一點。

我已經解決了問題 #1。 無論變量名是否被引用,您的 function 都可以工作。

MyFunction <- function(data,
                       groupvar,
                       var) {
  # Issue #1 is this best way to warn/stop user?
  lst <- as.list(match.call())

  if (is.symbol(lst$groupvar)) {
    q <- paste0("groupvar")
    varname <- expr('$'(lst,!!q))
    gval <- eval_tidy(varname)
    groupvarc <- as.character(gval)
  }else{groupvarc <- eval_tidy(lst$groupvar)}

  if (is.symbol(lst$var)) {
    v <- paste0("var")
    varnam <- expr('$'(lst,!!v))
    vval <- eval_tidy(varnam)
    varc <- as.character(vval)
  }else{varc <- eval_tidy(lst$var)}

  grouplabel <- groupvarc[1] 

  data <- dplyr::select(.data = data,
                        var = varc[[1]],
                        groupvar = groupvarc[[1]] )

  aov_object <- aov(var ~ groupvar, data = data)
  aov_results <- broom::tidy(aov_object)  %>%
     mutate(term = if_else(term != "Residuals", grouplabel, term))
  return(aov_results)
}

MyFunction(data = dat1, groupvar = "State", var = "var1") # works

MyFunction(data = dat1, groupvar = State, var = var1) # Also works

對於多個變量,您需要將其設為 function 並通過lapply循環。 此外,它會整理我對問題 #1 重復兩次相同的代碼。 我希望這可以幫助您繼續前進。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM