Question

我有一个带有特殊列的数据框 df ：

df<- data.frame(w= 1:3, x=3:5, y=6:8, z = I(list(1:2, 1:3, 1:4)))
df <- as.data.frame(do.call(cbind, lapply(df[1:3], function(x) Map("*", 
         df$z, x))))

>df

           w                x                  y
        1, 2             3, 6              6, 12
     2, 4, 6         4, 8, 12          7, 14, 21
 3, 6, 9, 12    5, 10, 15, 20      8, 16, 24, 32

我想用数字6替换 df 中值小于6的任何数字，并用数字8替换每个大于8的值。我不想触碰中间的数字而且我想保持数据框结构。

为此，我编写了一个函数 transfo

transfo<- function(x){
  x <- unlist(x)
  if (x < 6){ x <- 6}
  if (x > 8){ x <- 8}
  x 
}

当我运行以下代码时：

transformed <- as.data.frame(sapply(df, transfo))

我收到10条警告消息：

1: In if (x < 6) { :
  the condition has length > 1 and only the first element will be used

...并且我没有得到所需的输出。

我的预期输出是

>transformed 

               w                x                  y
            6, 6             6, 6               6, 8
         6, 6, 6          6, 8, 8            7, 8, 8
      6, 6, 8, 8       6, 8, 8, 8         8, 8, 8, 8

我非常感谢提示以最快的方式替换数据框 df 的所有元素（如果小于6，则替换为6；如果大于8，则替换为8），因为我处理具有3000行的大型数据集。

谢谢。

Answer 1

假设列为list的{{1}}，则OP得到警告，因为存在多个元素或vector大于1。而不是{{1} }我们可以在length中使用if/else或ifelse或if_else（因为我们需要更改所有列），并在{{1} }}

case_when

或使用mutate_all

list

我们可以map将其应用到每个嵌套的library(tidyverse) out <- df %>% mutate_all(funs(map(., ~ case_when(.x < 6 ~ 6, .x > 8 ~ 8, TRUE ~ as.numeric(.x))))) out # w x y #1 6, 6 6, 6 6, 8 #2 6, 6, 6 6, 8, 8 7, 8, 8 #3 6, 6, 8, 8 6, 8, 8, 8 8, 8, 8, 8上，而不是pmin/pmax，然后再将其df %>% mutate_all(funs(map(., ~pmax(.x, 6) %>% pmin(8)))) # w x y #1 6, 6 6, 6 6, 8 #2 6, 6, 6 6, 8, 8 7, 8, 8 #3 6, 6, 8, 8 6, 8, 8, 8 8, 8, 8, 8回到原来的list

unlist

或者relist

中的逻辑相同

structure

或者在df %>% mutate_all(funs(relist(pmin(pmax(unlist(.), 6), 8), skeleton = .)))

中

base R

基准

通过复制“ df”的行来创建稍大的数据集

df[] <- lapply(df, function(x) relist(pmin(pmax(unlist(x), 6), 8), skeleton = x))

data.table和library(data.table) setDT(df)[, lapply(.SD, function(x) relist(pmin(pmax(unlist(x), 6), 8), skeleton = x))]（df1 <- df[rep(seq_len(nrow(df)), 5000),] system.time({ df1 %>% mutate_all(funs(map(., ~pmax(.x, 6) %>% pmin(8)))) }) # user system elapsed # 6.116 0.017 6.159 system.time({ df1 %>% mutate_all(funs(relist(pmin(pmax(unlist(.), 6), 8), skeleton = .))) }) # user system elapsed # 0.389 0.000 0.389）方法的时间也与data.table中使用lapply的修改代码的时间相似。

Answer 2

也可以

> out <- as.data.frame(do.call(cbind, lapply(df, function(i){
     lapply(i, function(j){
         ifelse((j < 6), 6, ifelse((j > 8), 8, j))
     })
 })))
> out
           w          x          y
1       6, 6       6, 6       6, 8
2    6, 6, 6    6, 8, 8    7, 8, 8
3 6, 6, 8, 8 6, 8, 8, 8 8, 8, 8, 8

根据阈值用特殊列（列表列）替换数据框的元素

2 个答案:

基准