Метки фактора обрезки для нескольких переменных одновременно - PullRequest
Новая
       101

Метки фактора обрезки для нескольких переменных одновременно

2 голосов
/ 26 мая 2020

Это мой набор данных о игрушках: 

 library(tidyverse)
dat <- tibble (x1 = c("False - very long label specific to x1", "False - very long label specific to x1", "True - very long label specific to x1", "True - very long label specific to x1"),
               x2 = c("False - very long label specific to x2", "False - very long label specific to x2", "False - very long label specific to x2", "True - very long label specific to x2"),
               y = c(10, 5, 12, 4)) %>% mutate_at(vars(x1:x2), factor)
head(dat)
#> # A tibble: 4 x 3
#>   x1                                x2                                    y
#>   <fct>                             <fct>                             <dbl>
#> 1 False - very long label specific~ False - very long label specific~    10
#> 2 False - very long label specific~ False - very long label specific~     5
#> 3 True - very long label specific ~ False - very long label specific~    12
#> 4 True - very long label specific ~ True - very long label specific ~     4

Я бы хотел обрезать очень длинные метки факторов, все они имеют две общие черты:

  1. все начинаются с True или False
  2. включить имя столбца (ie метки факторов для каждого столбца уникальны)

Я хотел бы упростите это и укажите только что-то вроде True и False для каждого столбца факторов. Это мой желаемый результат: 


#> # A tibble: 4 x 3
#>   x1    x2        y
#>   <fct> <fct> <dbl>
#> 1 False False    10
#> 2 False False     5
#> 3 True  False    12
#> 4 True  True      4

Я думаю, он должен работать с чем-то вроде mutate_at и fct_relabel и, возможно, str_trunc, но я не мог этого понять.

1 Ответ

3 голосов
/ 26 мая 2020

Мы можем использовать trimws с whitespace

library(dplyr)
dat %>% 
    mutate_if(is.factor, ~ factor(trimws(., whitespace = "\\s*-.*")))
# A tibble: 4 x 3
#  x1    x2        y
#  <fct> <fct> <dbl>
#1 False False    10
#2 False False     5
#3 True  False    12
#4 True  True      4

Или с fct_relabel и str_remove

library(forcats)
library(stringr)
dat %>% 
    mutate_if(is.factor, ~ fct_relabel(., ~str_remove(., '\\s*-.*')))

Или используя data.table

library(data.table)
m1 <- names(which(sapply(dat, is.factor)))
setDT(dat)[, (nm1) := lapply(.SD, function(x) 
        factor(sub('\\s*-.*', "", x))) , .SDcols = nm1]
...