使用 R 中的命名向量按列和行对表进行子集

Question

以diamonds 数据集（来自ggplot2 库）为例，我试图根据命名元素的向量按列和行对该表进行子集化（向量的名称应用于子集化按列和相应的向量元素按行）。

library(ggplot2)
diamonds
# A tibble: 53,940 x 10
   carat cut       color clarity depth table price     x     y     z
   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
 1 0.23  Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43
 2 0.21  Premium   E     SI1      59.8    61   326  3.89  3.84  2.31
 3 0.23  Good      E     VS1      56.9    65   327  4.05  4.07  2.31
 4 0.290 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63
 5 0.31  Good      J     SI2      63.3    58   335  4.34  4.35  2.75
 6 0.24  Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48
 7 0.24  Very Good I     VVS1     62.3    57   336  3.95  3.98  2.47
 8 0.26  Very Good H     SI1      61.9    55   337  4.07  4.11  2.53
 9 0.22  Fair      E     VS2      65.1    61   337  3.87  3.78  2.49
10 0.23  Very Good H     VS1      59.4    61   338  4     4.05  2.39
# … with 53,930 more rows

myVector <- c(cut="Ideal", cut="Good", color="E", color="J")
myVector
    cut     cut   color   color 
"Ideal"  "Good"     "E"     "J" 

我打算做的事情如下，但使用myVector：

library(dplyr)
diamonds %>% subset(., (cut=="Ideal" | cut=="Good") & (color=="E" | color=="J")) %>%
select(cut, color)

Answer 1

从ThomasIsCoding 的split 思想开始，稍作改动，这里是基于Reduce/Map 创建逻辑索引的基本R 解决方案。

v <- split(unname(myVector), names(myVector))
i <- Reduce('&', Map(function(x, y){x %in% y}, diamonds[names(v)], v))
diamonds[i, ]
## A tibble: 6,039 x 10
#   carat cut   color clarity depth table price     x     y     z
#   <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
# 1  0.23 Ideal E     SI2      61.5    55   326  3.95  3.98  2.43
# 2  0.23 Good  E     VS1      56.9    65   327  4.05  4.07  2.31
# 3  0.31 Good  J     SI2      63.3    58   335  4.34  4.35  2.75
# 4  0.3  Good  J     SI1      64      55   339  4.25  4.28  2.73
# 5  0.23 Ideal J     VS1      62.8    56   340  3.93  3.9   2.46
# 6  0.31 Ideal J     SI2      62.2    54   344  4.35  4.37  2.71
# 7  0.3  Good  J     SI1      63.4    54   351  4.23  4.29  2.7 
# 8  0.3  Good  J     SI1      63.8    56   351  4.23  4.26  2.71
# 9  0.23 Good  E     VS1      64.1    59   402  3.83  3.85  2.46
#10  0.33 Ideal J     SI1      61.1    56   403  4.49  4.55  2.76
## ... with 6,029 more rows

包dplyr

上面的代码可以写成函数，在dplyr::filter中使用。

# Input:
# X - a data set to be filtered
# values - a named list
values_in <- function(X, values){
  v <- split(unname(values), names(values))
  i <- Reduce('&', Map(function(x, y){x %in% y}, X[names(v)], v))
  i
}

diamonds %>% filter( values_in(., myVector) )

输出与上面相同，因此省略。

Answer 2

我不确定你是否想要像下面这样的东西

u <- split(myVector,names(myVector))
eval(str2expression(sprintf("diamonds %%>%% filter(%s)",paste0(sapply(names(u),function(x) paste0(x," %in% u$",x)),collapse = " & "))))

这样

> eval(str2expression(sprintf("diamonds %%>%% filter(%s)",paste0(sapply(names(u),function(x) paste0(x," %in% u$",x)),collapse = " & "))))
# A tibble: 6,039 x 10
   carat cut   color clarity depth table price     x     y     z
   <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
 1  0.23 Ideal E     SI2      61.5    55   326  3.95  3.98  2.43
 2  0.23 Good  E     VS1      56.9    65   327  4.05  4.07  2.31
 3  0.31 Good  J     SI2      63.3    58   335  4.34  4.35  2.75
 4  0.3  Good  J     SI1      64      55   339  4.25  4.28  2.73
 5  0.23 Ideal J     VS1      62.8    56   340  3.93  3.9   2.46
 6  0.31 Ideal J     SI2      62.2    54   344  4.35  4.37  2.71
 7  0.3  Good  J     SI1      63.4    54   351  4.23  4.29  2.7
 8  0.3  Good  J     SI1      63.8    56   351  4.23  4.26  2.71
 9  0.23 Good  E     VS1      64.1    59   402  3.83  3.85  2.46
10  0.33 Ideal J     SI1      61.1    56   403  4.49  4.55  2.76
# ... with 6,029 more rows

Answer 3

使用@Roman（生成向量元素和连接的所有组合）和@ThomaslsCoding（拆分向量）提出的两种方法似乎可以解决问题：

data.frame(split(myVector, names(myVector))) %>% 
expand.grid() %>% 
inner_join(diamonds[,unique(names(myVector))])

Answer 4

你可以试试

my_vec_cut = myVector[names(myVector) == "cut"]
my_vec_color = myVector[names(myVector) == "color"]

我将向量分成两部分，因为您使用 and 和 or 过滤了两列

diamonds %>% 
  filter(.data[[unique(names(my_vec_cut))]] %in%  my_vec_cut & .data[[unique(names(my_vec_color))]] %in%  my_vec_color)

一般的方法是加入方法。首先你从你的向量构建所有需要的组合，然后你离开加入数据。

library(tidyverse)
tibble(a=names(myVector), b=myVector) %>%
    group_by(a) %>% 
    mutate(n=1:n()) %>% 
    pivot_wider(names_from = a, values_from=b) %>%
    select(-n) %>% 
    complete(cut, color) 
# A tibble: 4 x 2
  cut   color
  <chr> <chr>
1 Good  E    
2 Good  J    
3 Ideal E    
4 Ideal J    

# now left_joining:
tibble(a=names(myVector), b=myVector) %>%
  group_by(a) %>% 
  mutate(n=1:n()) %>% 
  pivot_wider(names_from = a, values_from=b) %>%
  select(-n) %>% 
  complete(cut, color) %>% 
  left_join(diamonds) 
  count(cut, color)

Answer 5

类似于 @ThomasIsCoding 的想法，只是在基础 R 中。

al <- split(myVector, names(myVector))

res <- with(diamonds, diamonds[eval(parse(text=paste(sapply(names(al), function(x) 
  paste0(x, " %in% ", "al[['", x, "']]")), collapse=" & "))), ])

unique(res$cut)
# [1] Ideal Good 
# Levels: Fair < Good < Very Good < Premium < Ideal
unique(res$color)
# [1] E J
# Levels: D < E < F < G < H < I < J

Answer 6

如果您不使用具有字符（而不是表达式）作为名称的向量，它会变得更容易并且可能更具可读性：

library(ggplot2)
library(tidyverse)
library(rlang)

my_filter <- function(d, x, selection) {
  cmd <- map2(x, selection, ~quo(`%in%`(!!.x, !!.y))) # create filter expression
  d %>%
    filter(!!!cmd) %>% # filter
    select(!!!x) # select columns cut and color (in this case)
}    
diamonds %>%
  my_filter(x = vars(cut, color),
            sel = list(c("Ideal", "Good"), c("E", "J")))

# # A tibble: 6,039 x 2
# cut   color
# <ord> <ord>
#   1 Ideal E    
# 2 Good  E    
# 3 Good  J    
# 4 Good  J    
# 5 Ideal J    
# 6 Ideal J    
# 7 Good  J    
# 8 Good  J    
# 9 Good  E    
# 10 Ideal J    
# # ... with 6,029 more rows