【问题标题】：Keep the correlative number of a vectorized apply function in R在 R 中保持矢量化应用函数的相关数
【发布时间】：2021-02-27 22:46:08
【问题描述】：

使用下面的数据，我想将以下操作向量化为 apply 调用，但这样做时我会丢失每个向量化操作的相关数。

示例数据如下：

library(VGAM)
library(dplyr)

df<- structure(list(id_choice = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L,3L), V1 = c(-2.1578610393492, -7.99842015838894, -2.75141490020271,-10.4498142778112, -1.24287958770339, -0.378360296432904, -5.4054060545789,-1.91973213468639, -3.43124320737278), V2 = c(-0.707981236327309,-2.46810236795902, -0.929869936267716, -5.0157210007768, -0.602127441470801,-0.186681393158885, -2.06095189374723, -0.706069723181491, -1.04581628613078), V3 = c(-0.707981236327309, -2.46810236795902, -0.929869936267716,-3.34318115860932, -0.419902425557776, -0.141349098342894, -2.06095189374723,-0.706069723181491, -1.04581628613078)), row.names = c(NA, -9L), groups = structure(list(id_choice = 1:3, .rows = structure(list(1:3, 4:6, 7:9), ptype = integer(0), class = c("vctrs_list_of","vctrs_vctr", "list"))), row.names = c(NA, 3L), class = c("tbl_df","tbl", "data.frame"), .drop = TRUE), class = c("grouped_df","tbl_df", "tbl", "data.frame"))

# id_choice      V1     V2     V3
# 1         1  -2.16  -0.708 -0.708
# 2         1  -8.00  -2.47  -2.47 
# 3         1  -2.75  -0.930 -0.930
# 4         2 -10.4   -5.02  -3.34 
# 5         2  -1.24  -0.602 -0.420
# 6         2  -0.378 -0.187 -0.141
# 7         3  -5.41  -2.06  -2.06 
# 8         3  -1.92  -0.706 -0.706
# 9         3  -3.43  -1.05  -1.05

我需要对每个 V1、V2 和 V3 应用相同的 2 个操作。它们是：

生成U <- V + Gumbel error
生成一个二进制 (choice) 变量，该变量在 U by id_choice 的最大值处取值 1

广泛（而且绝对不合适）的方法如下（也非常欢迎对当前方法的第 2 点进行任何改进）。我将其称为哑方法

Dumb [but working] 方法

# For V1...
# adding the random part to the error rgumbel
df$U1 <- df$V1 + rgumbel(nrow(df) , loc=0 , scale=1)  
# generating choice variable 
id_choice_split_1 <- with(df, split(U1,id_choice))
df$choice1 <- unlist(lapply(id_choice_split_1,
                            function(uValues)
                              as.numeric(uValues == max(uValues))))

# ...for V2...
# adding the random part to the error rgumbel
df$U2 <- df$V2 + rgumbel(nrow(df) , loc=0 , scale=1)  
# generating choice variable 
id_choice_split2 <- with(df, split(U2,id_choice))
df$choice2       <- unlist(lapply(id_choice_split2,
                                  function(uValues)
                                    as.numeric(uValues == max(uValues))))

# ...for V3.
# adding the random part to the error rgumbel
df$U3 <- df$V3 + rgumbel(nrow(df) , loc=0 , scale=1)  
# generating choice variable 
id_choice_split3 <- with(df, split(U3,id_choice))
df$choice3       <- unlist(lapply(id_choice_split3,
                                  function(uValues)
                                    as.numeric(uValues == max(uValues))))

导致……

# id_choice      V1     V2     V3     U1   choice1   U2   choice2   U3   choice3
# 1         1  -2.16  -0.708 -0.708 -2.89        0 -1.09        1 -1.42        0
# 2         1  -8.00  -2.47  -2.47  -8.94        0 -3.17        0 -2.15        0
# 3         1  -2.75  -0.930 -0.930 -2.51        1 -1.22        0 -0.130       1
# 4         2 -10.4   -5.02  -3.34  -8.87        0 -5.77        0 -2.82        0
# 5         2  -1.24  -0.602 -0.420  1.30        1 -0.477       0 -0.942       0
# 6         2  -0.378 -0.187 -0.141 -0.463       0  1.49        1 -0.121       1
# 7         3  -5.41  -2.06  -2.06  -4.28        0 -0.509       0 -1.31        0
# 8         3  -1.92  -0.706 -0.706 -0.633       1 -0.486       1  1.77        1
# 9         3  -3.43  -1.05  -1.05  -2.89        0 -1.68        0 -0.975       0

最后，只保留相关变量（又名：id_choicechoice1、choice2 和 choice3）。

这是我的想要的输出

#keeping just relevant variables 
df<- data.frame(select(df,-c(U1,V1,
                                U2,V2,
                                U3,V3)))

#   id_choice choice1 choice2 choice3
# 1         1       0       1       0
# 2         1       0       0       0
# 3         1       1       0       1
# 4         2       0       0       0
# 5         2       1       0       0
# 6         2       0       1       1
# 7         3       0       0       0
# 8         3       1       1       1
# 9         3       0       0       0

鉴于只是重复操作，我宁愿将它们自动化。因此，我创建了一个使用apply 调用的函数：

聪明的[但还没有工作]方法

choice_generator <- function(V){
  require(VGAM)
  V <- as.data.frame(V)
  # adding the random part to the error rgumbel
  U <- V + rgumbel(nrow(V) , loc=0 , scale=1)  
  # generating choice variable 
  id_choice_split <- with(df, split(U,id_choice))
  choice       <- unlist(lapply(id_choice_split,
                                function(uValues) as.numeric(uValues == max(uValues))))
  #keep it as data.frame
  choice <- data.frame(choice)
}

# getting a list with the choice variables
list_with_choices <-  apply(df[grep('V', names(df))] ,
                            MARGIN = 2,
                            FUN =choice_generator )

#generate_data_frame from the obtained list.
df$choices <- do.call("cbind", list_with_choices)

导致...

# id_choice      V1     V2     V3 choices$choice $choice $choice
# 1         1  -2.16  -0.708 -0.708              0       0       1
# 2         1  -8.00  -2.47  -2.47               0       0       0
# 3         1  -2.75  -0.930 -0.930              1       1       0
# 4         2 -10.4   -5.02  -3.34               0       0       0
# 5         2  -1.24  -0.602 -0.420              0       0       0
# 6         2  -0.378 -0.187 -0.141              1       1       1
# 7         3  -5.41  -2.06  -2.06               0       0       0
# 8         3  -1.92  -0.706 -0.706              1       1       0
# 9         3  -3.43  -1.05  -1.05               0       0       1

#New names:
#* choices.choice -> choices.choice...5
#* choices.choice -> choices.choice...6
#* choices.choice -> choices.choice...7


colnames(df)
#[1] "id_choice" "V1"        "V2"        "V3"        "choices"

如你所见，我失去了我想要的输出，因为我从愚蠢的方法中得到的 choice1、choice2 和 choice3 的相关数量不见了。

可以通过修改我的函数来保留相关数字吗？还是我想念的另一件事？提前感谢您的宝贵时间！

【问题讨论】：

标签： r dataframe dplyr vectorization apply

【解决方案1】：

Smart [但还没有工作] 方法

保留名称的一种简单方法是在调用 cbind 之前使用rlist::flatten()：

do.call("cbind", rlist::list.flatten(list_with_choices)) 
#      V1.choice V2.choice V3.choice
# [1,]         0         1         0
# [2,]         0         0         0
# [3,]         1         0         1
# ...

`dplyr` 方法

我认为这是dplyr 发光的情况之一：您可以使用简单的group_by(id_choice)，而不是splitting 然后unlisting 等等，然后在各个Vx 列上应用一个函数（不需要知道df):

choice_generator2 <- function(V){
  U <- V + rgumbel(length(V), 0, 1)
  1L * (U == max(U))
}

df %>%
  group_by(id_choice) %>%
  mutate(choice1 = choice_generator2(V1))

您也可以将其应用于所有列（在此过程中替换它们）：

df %>%
  group_by(id_choice) %>%
  mutate(across(starts_with("V"), choice_generator2))

或者使用值创建新列：

df %>%
  group_by(id_choice) %>%
  mutate(across(starts_with("V"), choice_generator2, .names = "choice_{.col}"))
# A tibble: 9 x 7
# Groups:   id_choice [3]
#   id_choice      V1     V2     V3 choice_V1 choice_V2 choice_V3
#       <int>   <dbl>  <dbl>  <dbl>     <int>     <int>     <int>
# 1         1  -2.16  -0.708 -0.708         1         1         0
# 2         1  -8.00  -2.47  -2.47          0         0         1
# 3         1  -2.75  -0.930 -0.930         0         0         0
# 4         2 -10.4   -5.02  -3.34          0         0         0
# 5         2  -1.24  -0.602 -0.420         1         0         0
# 6         2  -0.378 -0.187 -0.141         0         1         1
# 7         3  -5.41  -2.06  -2.06          0         0         0
# 8         3  -1.92  -0.706 -0.706         1         0         1
# 9         3  -3.43  -1.05  -1.05          0         1         0

【讨论】：

非常感谢@Alexlok 的精彩回答，这正是我所寻找的。此外，我对 R 非常陌生，每次编写代码时，我都觉得有很多其他更有效/更快的方法可以做到这一点，还有很多库，感觉就像一个全新的宇宙在自身。因此，大多数时候，我会尽可能地坚持使用 baseR，但显然，我失去了很多很酷的功能。是dplyr 新的_unsaid 黄金标准_ 还是类似的东西？你会推荐它来包装吗？再次感谢您！
你可以在网上找到很多关于这个问题的讨论，但简而言之，是的：dplyr/tidyverse 方法让大多数标准分析的生活变得更加轻松，你绝对应该学习它。我通过阅读r4ds 学到了大部分内容。在函数和包中使用有点复杂，但没什么可怕的。我想说它现在是一个被广泛接受的“黄金标准”，看看这里的其他 R Q/A。

Dumb [but working] 方法

聪明的[但还没有工作]方法

Smart [但还没有工作] 方法

dplyr 方法

`dplyr` 方法