Как можно свернуть несколько столбцов и генерировать новые переменные из разных уровней / значений, которые были свернуты? - PullRequest
Новая
       35

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

0 голосов
/ 26 мая 2019

У меня есть набор данных (df), подобный этому: 

df <- data.frame("ID"=c(1, 1, 1, 2, 2), 
                 "Method of payment"=c("cash","liabilities", 
                                       "shares", "cash", NA), 
                 "USD"=c(110, 130, 200, 100, NA), 
                 "var3"=c(1500, NA, NA, "ab", "bc"))
df
#   ID Method.of.payment USD var3
# 1  1              cash 110 1500
# 2  1       liabilities 130 <NA>
# 3  1            shares 200 <NA>
# 4  2              cash 100   ab
# 5  2              <NA>  NA   bc

И я хотел бы иметь: 

data.frame("ID"=c(1, 2), 
           "Method of payment"=c("cash, liabilities, shares", "cash"), 
           "Cash"=c(110, 100), 
           "Liabilities"=c(130, 0),
           "Shares"=c(200, 0),
           "var3"=c(1500, "ab,bc"))

#   ID         Method.of.payment Cash Liabilities Shares  var3
# 1  1 cash, liabilities, shares  110         130    200  1500
# 2  2                      cash  100           0      0 ab,bc

Поэтому я бы хотел

  1. свернуть переменные «метод оплаты» и «var3», чтобы иметь только одну строку для каждого идентификатора, со всеми уровнями / значениями, связанными с идентификатором, вставленным в одну строку;
  2. генерирует новые переменные из существующих уровней метода оплаты факторной переменной («денежные средства», «обязательства», «акции»), значения которых должны быть соответствующими значениями переменной USD или 0, если нет соответствующихзначение.

Я работаю с очень большим набором данных, поэтому я ищу что-то, что работает и с большими данными.Я надеюсь, что это ясно.

Ответы [ 3 ]

0 голосов
/ 27 мая 2019

Вы можете использовать by и reshape, чтобы перевести USD в широкоформатный формат, опуская столбец var3. 

b <- by(df1, df1$id, reshape, direction="wide", timevar="method.of.payment", drop="var3")
b <- Reduce(function(x, y) merge(x, y, all=TRUE), b)  # merge the list resulting from `by`

Чтобы свернуть уровни, вы можете использовать toString в другомby и cbind к объединенному 

res <- cbind(b, do.call(rbind, by(df1[c(2, 4)], df1$id, function(X) 
  lapply(X, function(x) toString(na.omit(x))))))[c(1, 6, 2:4, 7)]  # some column sorting 
res
#   id         method.of.payment usd.cash usd.liabilities usd.shares   var3
# 1  1 cash, liabilities, shares      110             130        200   1500
# 2  2                      cash      100              NA         NA ab, bc

Редактировать: Возможно, это более элегантно сделать всего за один by. 

b <- by(df1, df1$id, function(X) {
  r <- reshape(X, direction="wide", timevar="method.of.payment", drop="var3")
  s <- lapply(X[c(2, 4)], function(x) toString(na.omit(x)))
  return(merge(r, s))
  })

res <- Reduce(function(x, y) merge(x, y, all=TRUE), b)[c(1, 3, 2, 5:6, 4)]
res
#   id         method.of.payment usd.cash usd.liabilities usd.shares   var3
# 1  1 cash, liabilities, shares      110             130        200   1500
# 2  2                      cash      100              NA         NA ab, bc

Данные

Примечание: Лучше избегать пробелов в именах столбцов в R. 

df1 <- structure(list(id = c(1, 1, 1, 2, 2), method.of.payment = structure(c(1L, 
2L, 3L, 1L, NA), .Label = c("cash", "liabilities", "shares"), class = "factor"), 
    usd = c(110, 130, 200, 100, NA), var3 = structure(c(1L, NA, 
    NA, 2L, 3L), .Label = c("1500", "ab", "bc"), class = "factor")), class = "data.frame", row.names = c(NA, 
-5L))
0 голосов
/ 27 мая 2019

Сообщение об ошибке говорит

Ключи разделены на 2 строки: * 6, 7

, который можно увидеть в строках 6 и 7 в следующем выводе, т. Е. Метод одинаков в строках 6 и 7, так как spread назначит их другому столбцу 

df %>% group_by(ID) %>% 
       mutate(MofP=paste(Method, collapse = ','),var3=paste(var3[!is.na(var3)], collapse = ','))

# A tibble: 7 x 5
# Groups:   ID [3]
     ID Method        USD var3  MofP                   
   <dbl> <fct>       <dbl> <chr> <chr>                  
1     1 cash          110 1500  cash,liabilities,shares
2     1 liabilities   130 1500  cash,liabilities,shares
3     1 shares        200 1500  cash,liabilities,shares
4     2 cash          100 ab,bc cash,NA                
5     2 NA             NA ab,bc cash,NA                
6     3 NA             NA 10    NA,NA                  
7     3 NA             NA 10    NA,NA

Чтобы решить эту проблему, мы можем сделать: 

#Option 1. Select groups where Method is unique among the group, then do spread as usual
df %>% group_by(ID) %>% 
       mutate(MofP=paste(Method, collapse = ','),var3=paste(var3[!is.na(var3)], collapse = ',')) %>% 
       filter(n_distinct(Method)==n())

#Option 2. Follow dplyr erro msg Do you need to create unique ID with tibble::rowid_to_column()?, 
#but create our own id
df %>% group_by(ID) %>% mutate(MofP=paste(Method, collapse = ','),var3=paste(var3[!is.na(var3)], collapse = ','), 
                               rid=if(n_distinct(Method)!=n()) row_number() else 1) %>% 
      spread(key=Method, value=USD, fill = 0)

# A tibble: 4 x 8
# Groups:   ID [3]
     ID var3  MofP                      rid  cash liabilities shares `<NA>`
   <dbl> <chr> <chr>                   <dbl> <dbl>       <dbl>  <dbl>  <dbl>
1     1 1500  cash,liabilities,shares     1   110         130    200      0
2     2 ab,bc cash,NA                     1   100           0      0      0
3     3 10    NA,NA                       1     0           0      0      0
4     3 10    NA,NA                       2     0           0      0      0
0 голосов
/ 26 мая 2019

Вот решение через data.table, которое позволяет избежать репликации свернутых полей в нескольких строках. Узкое место в производительности составит paste: 

library(data.table)

df <- data.table(ID = c(1, 1, 1, 2, 2), 
                 Method = c("cash","liabilities", "shares", "cash", NA), 
                 USD = c(110, 130, 200, 100, NA), 
                 var3 = c(1500, NA, NA, "ab", "bc"))

nice_paste <- function(z) {
  paste(z[!is.na(z)], collapse = ", ")
}

# Compress 
part_1 <- df[, .(Method = .(nice_paste(Method)),
                 var3 = .(nice_paste(var3))), by = ID]

# Reshape "Method" to wide
part_2 <- dcast(df[!is.na(Method)], 
                ID ~ Method, 
                value.var = "USD", 
                fill = 0, 
                fun.aggregate = sum)

part_1[part_2, on = "ID"]

Придает 

   ID                    Method   var3 cash liabilities shares
1:  1 cash, liabilities, shares   1500  110         130    200
2:  2                      cash ab, bc  100           0      0
...