Как выполнить одно горячее кодирование в r

У каждой возможности ID есть несколько продуктов Я хочу иметь двоичный столбец, который говорит, есть ли у возможности этот продукт или нет. Как это сделать?

Вход

+---+---------------+--------+----------+----------+
|   | Opportunityid | Level  | Product1 | Product2 |
+---+---------------+--------+----------+----------+
| 1 |            10 | Low    | SS       | ISP      |
| 2 |            20 | High   | ISP      | Azure    |
| 3 |            30 | Normal | Azure    | ISP      |
| 4 |            40 |        | SS       |          |
| 5 |            50 |        | ISP      |          |
+---+---------------+--------+----------+----------+

Ожидаемый результат (проверяется продукт 1 и продукт 2)

+---+---------------+--------+----------+----------+--------+---------+-----------+
|   | Opportunityid | Level  | Product1 | Product2 | HasSS? | HasISP? | HasAzure? |
+---+---------------+--------+----------+----------+--------+---------+-----------+
| 1 |            10 | Low    | SS       | ISP      |      1 |       1 |         0 |
| 2 |            20 | High   | ISP      | Azure    |      0 |       1 |         1 |
| 3 |            30 | Normal | Azure    | ISP      |      0 |       1 |         1 |
| 4 |            40 |        | SS       |          |      1 |         |         0 |
| 5 |            50 |        | ISP      |          |      0 |       1 |         0 |
+---+---------------+--------+----------+----------+--------+---------+-----------+

Код

library(caret)
Products <- data.frame(
  Opportunityid=c(10, 20, 30, 40, 50),
  Level=c('Low', 'High', 'Normal', '', ''),
  Product1=c('SS', 'ISP', 'Azure', 'SS', 'ISP'),
  Product2=c('ISP', 'Azure', 'ISP', '',''))


# dummify the data
dmy <- dummyVars(" ~ .", data = Products)
trsf <- data.frame(predict(dmy, newdata = Products))
trsf

PS: У меня более 100 товаров, поэтому хочу автоматизировать процесс

3
0
2 105
2

Ответы 2

Вы можете использовать tidyverse для очистки данных:

library(tidyverse)
Products <- data.frame(
  Opportunityid=c(10, 20, 30, 40, 50),
  Level=c('Low', 'High', 'Normal', '', ''),
  Product1=c('SS', 'ISP', 'Azure', 'SS', 'ISP'),
  Product2=c('ISP', 'Azure', 'ISP', '',''), 
  stringsAsFactors = FALSE)

Products %>%
   gather(key, value, Product1:Product2) %>% ## collect all Product columns
   mutate(has = ifelse(value == '', '', 1)) %>%  ## add a dummy variable
   spread(value, has, fill = 0) %>%  ## spread the values back in wider format
   select(-key, -V1) %>% ## remove empty columns and former product column
   group_by(Opportunityid, Level) %>% ## group by to collapse rows
   summarise_at(vars(-(Opportunityid:Level)), funs(max)) ## collapse rows

#   A tibble: 5 x 5
#   Groups:   Opportunityid [?]
#   Opportunityid Level  Azure ISP   SS   
#           <dbl> <chr>  <chr> <chr> <chr>
# 1            10 Low    0     1     1    
# 2            20 High   1     1     0    
# 3            30 Normal 1     1     0    
# 4            40 ""     0     0     1    
# 5            50 ""     0     1     0    

Спасибо @thothal, я получаю это во время выполнения Ошибка в eval (expr, envir, enclos): объект 'V1' не найден

sara 10.09.2018 10:57

Вы полностью опускаете заявление select. Это произошло потому, что в вашем примере были пустые столбцы Product. Помогает?

thothal 10.09.2018 13:32

Вы имеете в виду, что мне нужно удалить пустые переменные в моем фрейме данных, чтобы удалить эту ошибку?

sara 10.09.2018 14:01

Нет, просто удалите select(-key, -V1) из моего кода и попробуйте еще раз.

thothal 10.09.2018 14:35

data.table подход, чтобы получить прибыль от его функций быстрого преобразования и объединения

Products <- data.frame(
  Opportunityid=c(10, 20, 30, 40, 50),
  Level=c('Low', 'High', 'Normal', '', ''),
  Product1=c('SS', 'ISP', 'Azure', 'SS', 'ISP'),
  Product2=c('ISP', 'Azure', 'ISP', '',''))

library( data.table )

#create the data.table
dt <- as.data.table( Products )
#first, melt all columns containing "Pruduct"
dt.melt <- melt(dt, id.vars = 1:2, measure.vars = grep( "Product" , names( dt ) ) )
#add a value of 1
dt.melt[, value2 := ifelse( value == "", NA, 1)]
#now cast
dt.cast <- dcast( dt.melt, Opportunityid ~ value, value.var = "value2")[, c("V1", "Opportunityid") := NULL]
#replace NA with 0
dt.cast[is.na(dt.cast)] <-0
#and bind
cbind(dt, dt.cast)

#    Opportunityid  Level Product1 Product2 Azure ISP SS
# 1:            10    Low       SS      ISP     0   1  1
# 2:            20   High      ISP    Azure     1   1  0
# 3:            30 Normal    Azure      ISP     1   1  0
# 4:            40              SS              0   0  1
# 5:            50             ISP              0   1  0

Контрольные точки

microbenchmark::microbenchmark( data.table = {
  #first, melt all columns containing "Pruduct"
  dt.melt <- melt(dt, id.vars = 1:2, measure.vars = grep( "Product" , names( dt ) ) )
  #add a value of 1
  dt.melt[, value2 := ifelse( value == "", NA, 1)]
  #now cast
  dt.cast <- dcast( dt.melt, Opportunityid ~ value, value.var = "value2")[, c("V1", "Opportunityid") := NULL]
  #replace NA with 0
  dt.cast[is.na(dt.cast)] <-0
  #and bind
  cbind(dt, dt.cast) },
dplyr = {
  Products %>%
    gather(key, value, Product1:Product2) %>% ## collect all Product columns
    mutate(has = ifelse(value == '', '', 1)) %>%  ## add a dummy variable
    spread(value, has, fill = 0) %>%  ## spread the values back in wider format
    select(-key, -V1) %>% ## remove empty columns and former product column
    group_by(Opportunityid, Level) %>% ## group by to collapse rows
    summarise_at(vars(-(Opportunityid:Level)), funs(max)) ## collapse rows
},
times = 100)

# Unit: milliseconds
#       expr       min        lq      mean    median        uq      max neval
# data.table  3.159354  3.395846  3.771977  3.598145  3.787187 13.68190   100
# dplyr      10.104990 10.451142 11.134228 10.694714 10.929098 29.83777   100

Не могли бы вы объяснить, что означает эта строка dt.cast <- dcast( dt.melt, Opportunityid ~ value, value.var = "value2")[, c("V1", "Opportunityid") := NULL]

sara 11.09.2018 09:24

потому что при использовании моего набора данных я получаю эту ошибку Aggregate function missing, defaulting to 'length' Warning message: In [.data.table(dcast(dt.melt, opportunityid ~ value, value.var = "value2"), : Adding new column 'V1' then assigning NULL (deleting it).

sara 11.09.2018 09:24

@sara: вы загрузили библиотеку data.table?

Wimpel 11.09.2018 14:45

да, я загрузил библиотеку

sara 12.09.2018 09:26

Другие вопросы по теме