Как сделать одну горячую кодировку в R

Question

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

Введите

+---+---------------+--------+----------+----------+
|   | 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 продуктов, поэтому я хочу, чтобы процесс был автоматизирован

Answer 1

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

Тесты * * 1004 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

Answer 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