R语言 实现基于规则赋值的有效方法

ylamdve6  于 2023-07-31  发布在  其他
关注(0)|答案(4)|浏览(100)

我正在尝试提出一种优雅的、基于规则的方法,根据列中的值组合为数据框中的行分配代码,使用以下数据:

library(tidyr)
df <- crossing(yr2018=c("M","S","W"),
               yr2019=c("M","S","W"),
                yr2020=c("M","S","W")) %>%
  print(n=27)

# A tibble: 27 × 3
   yr2018 yr2019 yr2020
   <chr>  <chr>  <chr> 
 1 M      M      M     
 2 M      M      S     
 3 M      M      W     
 4 M      S      M     
 5 M      S      S     
 6 M      S      W     
 7 M      W      M     
 8 M      W      S     
 9 M      W      W     
10 S      M      M     
11 S      M      S     
12 S      M      W     
13 S      S      M     
14 S      S      S     
15 S      S      W     
16 S      W      M     
17 S      W      S     
18 S      W      W     
19 W      M      M     
20 W      M      S     
21 W      M      W     
22 W      S      M     
23 W      S      S     
24 W      S      W     
25 W      W      M     
26 W      W      S     
27 W      W      W     
>

字符串
最后我想得到的是一个列,其中包含应用了如下规则的代码:

  • 如果yr 2018、yr 2019和yr 2020中的所有3个值都相同(MMM、SSS或WWW),则将新列值设置为“CON”和任何唯一值的级联,因此“CONM”、“CONNS”或“CONW”。
  • 如果第一列和第三列相同,但第二列不同,则根据行中的哪两个唯一值,将这两个唯一值按该顺序连接在一起,而不管列中的值的顺序如何。
  • 如果所有三种都不同,无论顺序如何,那么“MSW”
  • 如果最后两个值相同,但与第一个值不同,则将“CON”与最后一个值连接,因此可以是“CONM”、“CONS”或“CONW”
  • 最后,如果前两个相同而最后一个不同,则将“CON”与第一列连接,因此可以是“CONM”、“CONS”或“CONW”

这感觉像是一个很大的、丑陋的if语句,但我希望它更优雅,特别是因为我的真实的数据实际上是4x 5(625行)。它也感觉像是正则表达式,我很纠结。
我开始研究行函数,发现rowwise()作为逻辑重新配置 Dataframe 的起点,但看起来可以以这种方式操作的函数数量有限。
欢迎各位指导!

rur96b6h

rur96b6h1#

您可以使用mutatecase_when有效地满足这些条件。第二个逻辑中的sort将按照您描述的方式组织字母。
因为case_when迭代计算,所以你可以解析它,使它更优雅,但正如你所写的,它应该遵循你的确切条件:

library(dplyr)

df %>%
  rowwise() %>%
  mutate(new_column = case_when(
    yr2018 == yr2019 & yr2019 == yr2020 ~ paste0("CON", yr2018),
    yr2018 == yr2020 ~ paste(sort(c(yr2019, yr2020)), collapse = ""),
    yr2018 != yr2019 & yr2019 != yr2020 & yr2018 != yr2020 ~ "MSW",
    yr2019 == yr2020 & yr2018 != yr2020 ~ paste0("CON", yr2020),
    yr2018 == yr2019 & yr2018 != yr2020 ~ paste0("CON", yr2018)
  ))

字符串
输出量:

yr2018 yr2019 yr2020 new_column
   <chr>  <chr>  <chr>  <chr>     
 1 M      M      M      CONM      
 2 M      M      S      CONM      
 3 M      M      W      CONM      
 4 M      S      M      MS        
 5 M      S      S      CONS      
 6 M      S      W      MSW       
 7 M      W      M      MW        
 8 M      W      S      MSW       
 9 M      W      W      CONW      
10 S      M      M      CONM      
11 S      M      S      MS        
12 S      M      W      MSW       
13 S      S      M      CONS      
14 S      S      S      CONS      
15 S      S      W      CONS      
16 S      W      M      MSW       
17 S      W      S      SW        
18 S      W      W      CONW      
19 W      M      M      CONM      
20 W      M      S      MSW       
21 W      M      W      MW        
22 W      S      M      MSW       
23 W      S      S      CONS      
24 W      S      W      SW        
25 W      W      M      CONW      
26 W      W      S      CONW      
27 W      W      W      CONW

mwkjh3gx

mwkjh3gx2#

可以使用str_replace

df %>%
 mutate(new_column = str_replace(exec(str_c, !!!.),".*?(.)\\1+.*", "CON\\1")%>%
     str_replace('((.).)\\2', "\\1"))

# A tibble: 27 × 4
   yr2018 yr2019 yr2020 new_column
   <chr>  <chr>  <chr>  <chr>     
 1 M      M      M      CONM      
 2 M      M      S      CONM      
 3 M      M      W      CONM      
 4 M      S      M      MS        
 5 M      S      S      CONS      
 6 M      S      W      MSW       
 7 M      W      M      MW        
 8 M      W      S      MWS       
 9 M      W      W      CONW      
10 S      M      M      CONM

字符串
你也可以使用gsubfn::gsubfn

df %>%
   mutate(newcol = gsubfn::gsubfn(".*(.)\\1+.*|((.).)\\3", 
                     function(x,y,z)if(nzchar(z))y else str_c('CON', x), 
                           exec(str_c, !!!.), backref = -3))
# A tibble: 27 × 4
   yr2018 yr2019 yr2020 newcol
   <chr>  <chr>  <chr>  <chr> 
 1 M      M      M      CONM  
 2 M      M      S      CONM  
 3 M      M      W      CONM  
 4 M      S      M      MS    
 5 M      S      S      CONS  
 6 M      S      W      MSW   
 7 M      W      M      MW    
 8 M      W      S      MWS   
 9 M      W      W      CONW  
10 S      M      M      CONM

zy1mlcev

zy1mlcev3#

一种方法可以是使用rle,如果有连续的粘贴到CON,否则对唯一值进行排序。

sapply(apply(df, 1, rle, simplify = FALSE), \(x)
       if(is.na(i <- which(x$lengths > 1)[1]))
           paste(sort(unique(x$values)), collapse="")
       else  paste0("CON", x$value[i]) )
# [1] "CONM" "CONM" "CONM" "MS"   "CONS" "MSW"  "MW"   "MSW"  "CONW" "CONM"
#[11] "MS"   "MSW"  "CONS" "CONS" "CONS" "MSW"  "SW"   "CONW" "CONM" "MSW" 
#[21] "MW"   "MSW"  "CONS" "SW"   "CONW" "CONW" "CONW"

字符串

vngu2lb8

vngu2lb84#

对于较大的 Dataframe ,这可能是一个更好的解决方案,因为我们可以微调每个规则,除了已经发布的case_whenstr_replace答案之外。gather()方法可以将数据框转换为具有3列的较长格式,并添加“年份”和“值”。然后,我们可以使用rowwise对每行应用条件。这5条规则适用于case_when基于我们的新列year和value。然后ungroup()数据恢复到原始形式。

library(tidyr)
library(dplyr)

df <- crossing(yr2018 = c("M", "S", "W"),
               yr2019 = c("M", "S", "W"),
               yr2020 = c("M", "S", "W"))

df <- df %>%
  gather(year, value) %>%
  rowwise() %>%
  mutate(new_column = case_when(
    # Rule 1: All three values are the same
    all(value == value[1]) ~ paste0("CON", value[1]),

    # Rule 2: First and third columns are the same
    year[1] == year[3] & value[1] != value[2] ~ paste0(value[1], value[2]),
    year[1] == year[3] & value[1] != value[3] ~ paste0(value[1], value[3]),
    year[2] == year[3] & value[2] != value[1] ~ paste0(value[2], value[1]),

    # Rule 3: All three values are different
    all(value != value[1]) ~ "MSW",

    # Rule 4: Last two values are the same
    value[2] == value[3] & value[1] != value[2] ~ paste0("CON", value[2]),
    value[1] == value[3] & value[1] != value[2] ~ paste0("CON", value[3]),

    # Rule 5: First two values are the same
    value[1] == value[2] & value[1] != value[3] ~ paste0("CON", value[1])
  )) %>%
  ungroup() %>%
  select(-year, -value)

print(df)

字符串

相关问题