R语言有效地按行应用函数

wsxa1bj1 于 2023-07-31 发布在其他

关注(0)|答案(6)|浏览(124)

我有一个数据框，其中包含多个列，其中包含一个诊断的信息。条目为TRUE、FALSE或NA。我创建一个向量，将这些列总结如下：如果患者在某个时间被诊断（TRUE），则TRUE，如果唯一有效的条目是FALSE，则FALSE，如果只是缺失，则NA。以代码形式编写的文本：

data.frame(a= c(FALSE, TRUE, NA, FALSE, TRUE, NA, FALSE, TRUE, NA),
           b= c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, NA, NA, NA),
           expected= c(FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, NA))

字符串
我需要按行遍历所有列，我使用split来完成。不幸的是，我的数据很大，需要很长时间。我现在做的是

library(magrittr)
# big example data
df <- expand.grid(c(FALSE, TRUE, NA), c(FALSE, TRUE, NA)) %>%
  .[rep(1:nrow(.), 50000), ] %>%
  as.data.frame() %>%
  setNames(., nm= c("a", "b"))

# My approach
df$res <- df %>%
  split(., 1:nrow(.)) %>%
  lapply(., function(row_i){
    ifelse(all(is.na(row_i)), NA,
           ifelse(any(row_i, na.rm= TRUE), TRUE,
                  ifelse(any(!row_i, na.rm= TRUE), FALSE,
                         row_i)))
  }) %>%
  unlist()

型
有没有更有效的方法来解决这个问题？

来源：https://stackoverflow.com/questions/76711154/applying-function-rowwise-efficiently

6条答案

按热度按时间

hc2pp10m1#

使用pmax()的矢量化解决方案：

df$result <- as.logical(do.call(\(...) pmax(..., na.rm = TRUE), df[1:2]))

df
#       a     b expected result
# 1 FALSE FALSE    FALSE  FALSE
# 2  TRUE FALSE     TRUE   TRUE
# 3    NA FALSE    FALSE  FALSE
# 4 FALSE  TRUE     TRUE   TRUE
# 5  TRUE  TRUE     TRUE   TRUE
# 6    NA  TRUE     TRUE   TRUE
# 7 FALSE    NA    FALSE  FALSE
# 8  TRUE    NA     TRUE   TRUE
# 9    NA    NA       NA     NA

字符串
您还可以将所有参数合并到一个列表中，以避免do.call()中的匿名函数。

df$result <- as.logical(do.call(pmax, c(na.rm = TRUE, df[1:2])))

型

赞(0）回复(0）举报 2023-07-31

qc6wkl3g2#

一个选项是使用dplyr包中的向量化case_when()函数（https://dplyr.tidyverse.org/reference/case_when.html），例如：

library(dplyr)

df <- expand.grid(c(FALSE, TRUE, NA), c(FALSE, TRUE, NA)) %>%
  .[rep(1:nrow(.), 50000), ] %>%
  as.data.frame() %>%
  setNames(., nm= c("a", "b"))

df$res <- df %>%
  split(., 1:nrow(.)) %>%
  lapply(., function(row_i){
    ifelse(all(is.na(row_i)), NA,
           ifelse(any(row_i, na.rm= TRUE), TRUE,
                  ifelse(any(!row_i, na.rm= TRUE), FALSE,
                         row_i)))
  }) %>%
  unlist()
current_output <- df

# load 'clean' example data
df <- expand.grid(c(FALSE, TRUE, NA), c(FALSE, TRUE, NA)) %>%
  .[rep(1:nrow(.), 50000), ] %>%
  as.data.frame() %>%
  setNames(., nm= c("a", "b"))

case_when_output <- df %>%
  mutate(res = case_when(if_any(everything(), ~.x == TRUE) ~ TRUE,
                              if_all(everything(), ~is.na(.x)) ~ NA,
                              TRUE ~ FALSE))

all.equal(current_output, case_when_output)
#> [1] TRUE

字符串
创建于2023-07-18，使用reprex v2.0.2
Benchmark（6 yo酷睿-i5 MacBook Pro; 2023年7月20日更新）：

library(dplyr)
# install.packages("purrrlyr")
library(purrrlyr)
library(microbenchmark)
library(ggplot2)

df <- expand.grid(c(FALSE, TRUE, NA), c(FALSE, TRUE, NA)) %>%
  .[rep(1:nrow(.), 50000), ] %>%
  as.data.frame() %>%
  setNames(., nm= c("a", "b"))

ingo_pingo_func <- function(df) {
  df$res <- df %>%
  split(., 1:nrow(.)) %>%
  lapply(., function(row_i){
    ifelse(all(is.na(row_i)), NA,
           ifelse(any(row_i, na.rm= TRUE), TRUE,
                  ifelse(any(!row_i, na.rm= TRUE), FALSE,
                         row_i)))
  }) %>%
  unlist()
}

jared_mamrot_func <- function(df) {
  case_when_output <- df %>%
    mutate(res = case_when(if_any(1:2, ~.x == TRUE) ~ TRUE,
                              if_all(1:2, ~is.na(.x)) ~ NA,
                              TRUE ~ FALSE))
}

darren_tsai_func <- function(df) {
  df$result <- as.logical(do.call(\(...) pmax(..., na.rm = TRUE), df[1:2]))
}

roland_func <- function(df) {
  cols <- 1:2
  df$result <- Reduce(\(x, y) x | y, df[cols])
  df[is.na(df$result), "result"] <- Reduce(\(x, y) ifelse(!is.na(x) | !is.na(y), FALSE, NA), 
                                           df[is.na(df$result), cols])
}

yuriy_saraykin_func <- function(df) {
  whereNA <- rowSums(is.na(df)) == ncol(df)
  df$expected <- rowSums(df, na.rm = TRUE) > 0
  df$expected[whereNA] <- NA
}

efz_func <- function(df) {
  output <- df %>% by_row(..f=function(row_i){
    ifelse(all(is.na(row_i)), NA,
           ifelse(any(row_i, na.rm= TRUE), TRUE,
                  ifelse(any(!row_i, na.rm= TRUE), FALSE,
                         row_i)))
    
  }, .collate = 'rows')
}

TIC_func <- function(df) {
  df$result <- rowSums(df, na.rm = TRUE) > 0 * NA^(rowMeans(is.na(df)) == 1)
}

result <- microbenchmark(ingo_pingo_func(df),
                         jared_mamrot_func(df), 
                         darren_tsai_func(df),
                         roland_func(df),
                         yuriy_saraykin_func(df),
                         efz_func(df),
                         TIC_func(df),
                         times = 5)

result$expr <- forcats::fct_rev(forcats::fct_reorder(result$expr, result$time, mean))
autoplot(result)

型
x1c 0d1x的数据

赞(0）回复(0）举报 2023-07-31

mhd8tkvw3#

cols <- 1:2
DF$result <- Reduce(\(x, y) x | y, DF[cols])
DF[is.na(DF$result), "result"] <- Reduce(\(x, y) ifelse(!is.na(x) | !is.na(y), FALSE, NA), 
                                         DF[is.na(DF$result), cols])
#      a     b expected result
#1 FALSE FALSE    FALSE  FALSE
#2  TRUE FALSE     TRUE   TRUE
#3    NA FALSE    FALSE  FALSE
#4 FALSE  TRUE     TRUE   TRUE
#5  TRUE  TRUE     TRUE   TRUE
#6    NA  TRUE     TRUE   TRUE
#7 FALSE    NA    FALSE  FALSE
#8  TRUE    NA     TRUE   TRUE
#9    NA    NA       NA     NA

字符串

赞(0）回复(0）举报 2023-07-31

u7up0aaq4#

df <- data.frame(a= c(FALSE, TRUE, NA, FALSE, TRUE, NA, FALSE, TRUE, NA),
                 b= c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, NA, NA, NA))

whereNA <- rowSums(is.na(df)) == ncol(df)
df$expected <- rowSums(df, na.rm = TRUE) > 0
df$expected[whereNA] <- NA

df
#>       a     b expected
#> 1 FALSE FALSE    FALSE
#> 2  TRUE FALSE     TRUE
#> 3    NA FALSE    FALSE
#> 4 FALSE  TRUE     TRUE
#> 5  TRUE  TRUE     TRUE
#> 6    NA  TRUE     TRUE
#> 7 FALSE    NA    FALSE
#> 8  TRUE    NA     TRUE
#> 9    NA    NA       NA

字符串
创建于2023-07-18，使用reprex v2.0.2

赞(0）回复(0）举报 2023-07-31

oxosxuxt5#

另一种可能的方法：

library(purrrlyr)

df %>% by_row(..f=function(row_i){
  ifelse(all(is.na(row_i)), NA,
         ifelse(any(row_i, na.rm= TRUE), TRUE,
                ifelse(any(!row_i, na.rm= TRUE), FALSE,
                       row_i)))
  
}, .collate = 'rows')

字符串
这给了

a     b     .out 
   <lgl> <lgl> <lgl>
 1 FALSE FALSE FALSE
 2 TRUE  FALSE TRUE 
 3 NA    FALSE FALSE
 4 FALSE TRUE  TRUE 
 5 TRUE  TRUE  TRUE 
 6 NA    TRUE  TRUE 
 7 FALSE NA    FALSE
 8 TRUE  NA    TRUE 
 9 NA    NA    NA   
10 FALSE FALSE FALSE

型

赞(0）回复(0）举报 2023-07-31

enxuqcxy6#

您可以像下面这样使用rowSums + rowMean + is.na

> df$result <- rowSums(df, na.rm = TRUE) > 0 * NA^(rowMeans(is.na(df)) == 1)

> df
      a     b result
1 FALSE FALSE  FALSE
2  TRUE FALSE   TRUE
3    NA FALSE  FALSE
4 FALSE  TRUE   TRUE
5  TRUE  TRUE   TRUE
6    NA  TRUE   TRUE
7 FALSE    NA  FALSE
8  TRUE    NA   TRUE
9    NA    NA     NA

字符串

数据

df <- data.frame(
    a = c(FALSE, TRUE, NA, FALSE, TRUE, NA, FALSE, TRUE, NA),
    b = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, NA, NA, NA)
)

型

赞(0）回复(0）举报 2023-07-31

我来回答

R语言有效地按行应用函数

6条答案

数据

相关问题

热门标签

最新问答

R语言 有效地按行应用函数

6条答案

数据

相关问题

热门标签

最新问答

R语言有效地按行应用函数