Заменить элементы фрейма данных специальными столбцами (столбцами списка) в зависимости от порогового значения - PullRequest
Новая
       11

Заменить элементы фрейма данных специальными столбцами (столбцами списка) в зависимости от порогового значения

0 голосов
/ 25 июня 2018

У меня есть фрейм данных 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

Я хочу заменить любое число в df , которое имеет значение меньше 6 на число 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 строк.

Заранее спасибо.

Ответы [ 2 ]

0 голосов
/ 02 июля 2018

Также работает 

> 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
0 голосов
/ 25 июня 2018

Предполагая, что столбцы имеют значение list из vector, OP получил предупреждение, так как имеется более одного элемента или length больше 1. Вместо if/else мы можем использовать ifelse или if_else или 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[] <- 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))]

Тесты

Создан немного больший набор данных путем репликации строк 'df' 

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 (base R) также по времени аналогичны методам с dplyr с использованием модифицированного кода с relist

...