Как упростить case_when () внутри mutate ()

Question

У меня есть фрейм данных, и я хочу добавить столбец. Для этого я использую dplyr :: mutate. Однако значения столбца, которые я хочу добавить, зависят от значения другого столбца. Я использую case_when (), и проблема решена, но если есть много случаев, писать код неудобно (я покажу пример ниже), поэтому я хочу знать, есть ли другой вариант (возможно, цикл), чтобы упростить это.

Работает следующий код:

NewTable <- Table %>% 
  dplyr::mutate(ColumnB = case_when(
               ColumnA=="2000" ~ 0,
               ColumnA=="2001" ~ 4,
               ColumnA=="2002" ~ 8,
               ColumnA=="2003" ~ 12,
               ColumnA=="2004" ~ 16,
               ColumnA=="2005" ~ 20,
               ColumnA=="2006" ~ 24,
               ColumnA=="2007" ~ 28,
               ColumnA=="2008" ~ 32,
               ColumnA=="2009" ~ 36,
               ColumnA=="2010" ~ 40,
               ColumnA=="2011" ~ 44))

Как я могу его улучшить? Большое спасибо.

Answer 1

Поскольку вы изменили свои данные, вы можете попробовать это:

Table<-data.frame(A = c("2000", "2001", "2002", "2003", "2004"))
Table$B = (as.numeric(as.character(Table$A))-2000)*4 

Если у вас нет такого шаблона, вы можете сгенерировать список значений, соответствующих A и B, и объединитьих:

match_list<-data.frame(A = c("2000", "2001", "2002", "2003", "2004"),
                       B = c(0, 4, 8, 16, 20))
merge(Table, match_list, by = "A")  # Table itself does not have B at this stage

Это может сохранить только некоторые набор текста.

Answer 2

Это решение с использованием mapvalues из пакета plyr. Я часто им пользуюсь.

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
# Create a simulated data frame

set.seed(9049)

Table <- data.frame(columnA = as.character(sample(2000:2011, 
                                                  size = 100, 
                                                  replace = TRUE)),
                    stringsAsFactors = FALSE)

# Extract unique levels from column A
colA_levels <- unique(Table$columnA)

# Create unique levels of column B to map to
colB_levels <- (as.numeric(colA_levels) - 2000) * 4

# Use `mapvalues` from `plyr` package
# 
NewTable <- Table %>% 
  mutate(columnB = plyr::mapvalues(columnA,
                                   from = colA_levels,
                                   to = colB_levels))

head(NewTable, 10)
#>    columnA columnB
#> 1     2008      32
#> 2     2011      44
#> 3     2007      28
#> 4     2011      44
#> 5     2001       4
#> 6     2010      40
#> 7     2000       0
#> 8     2007      28
#> 9     2000       0
#> 10    2002       8

^{Создано в 2019-11-06 пакетом Представить (v0.3.0)}

Answer 3

Поскольку вы пишете столбец B, я предполагаю, что в Таблице его нет, поэтому объединение может помочь.

library(dplyr)
NewTable <- left_join( Table,
tibble( A = c("2000", "2001", "2002", "2003", "2004"),
        B = seq(from = 0, to = 32, by = 4) )

Answer 4

Вот как я это сделаю:

lkp <- setNames(c(0, 4, 8, 16, 20),
                c("2000", "2001", "2002", "2003", "2004"))
df <- data.frame(ColumnA = c("2004","2002"),stringsAsFactors = FALSE)
dplyr::mutate(df, ColumnB = lkp[ColumnA])
#>   ColumnA ColumnB
#> 1    2004      20
#> 2    2002       8

^{Создано в 2019-11-06 пакетом Представить (v0.3.0)}

Answer 5

Принимая во внимание комментарий ОП, вы могли бы тогда написать функцию (просит этот ответ ):

library(tidyverse)
letter2num <- function(x) {(utf8ToInt(x) - utf8ToInt("a")) * 2}
tibble(x = letters) %>% 
  rowwise() %>% 
  mutate(y = letter2num(x))