невозможно использовать lapply с data.table - PullRequest
Новая
       25

невозможно использовать lapply с data.table

0 голосов
/ 25 июня 2018

Я пытаюсь создать сводку всех символьных переменных в data.table.В основном, чтобы получить общее количество наблюдений, пропущенные значения, категорию с наибольшей частотой и т. Д. Однако я не могу правильно использовать lapply для того же.Вот воспроизводимый пример. 

library(data.table)

#Function to analyze one variable at a time
analyze_char_var <- function(x) {
  y = names(x)
  z = x[,.N,by=y]
  w = setorder(z,-N)

  out = data.table( 
    total_obs = nrow(x),
    missing_obs = sum(is.na(x)),
    unique_cats = nrow(z),
    top_cat = z[1,1],
    top_freq = z[1,2]
  )
  return(out)
}
#Function to analyze all variables. I want to use lapply instead of loop
analyze_all_char <- function(dt) {
  dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
  mylist = vector('list', length(dt.char))
  for (i in 1:length(dt.char)){
    x = dt.char[,i,with=FALSE]
    mylist[[i]] = analyze_char_var(x)
  }
  return(mylist)
}

dt = data.table(
  var1 = c('a', 'a', 'b','b', 'c'),
  var2 = 1:5,
  var3 = c('low','low','high','med',NA)
)
dt.analysis = analyze_all_char(dt)

Простое использование dt.analysis = dt.char[,lapply(.SD,analyze_char_var)] приводит к ошибке Error in x[, .N, by = y] : incorrect number of dimensions.Я попробовал некоторые варианты, но не смог заставить его работать.

РЕДАКТИРОВАТЬ: Наконец-то это работает для меня.Однако выглядит очень неуклюже.Преобразование входного вектора в data.table с последующим использованием lapply в виде data.frame. 

test_func <- function(x) {
  dt = as.data.table(x)
  dt.summ = dt[,.N,by='x'] #by default name is x
  # I was stuck in the above line, I was trying all 
  # sort of bad tricks to get the name of grouping variable 


  dt.summ.sorted = setorder(dt.summ,-N)
  out = data.table(
    total_obs = nrow(dt),
    missing_obs = sum(is.na(dt)),
    unique_cats = nrow(dt.summ.sorted),
    top_cat = dt.summ.sorted[1,1],
    top_freq = dt.summ.sorted[1,2]
  )
  return(out)
}

dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
lapply(dt.char,test_func)

Ответы [ 2 ]

0 голосов
/ 25 июня 2018

Я пытаюсь создать сводку всех символьных переменных в data.table.В основном, чтобы получить общее количество наблюдений, пропущенные значения, категорию с наибольшей частотой и т. Д.

Поскольку все интересующие столбцы имеют одинаковый тип, вы можете использовать melt для перехода в длинную форму: 

melt(dt.char <- Filter(is.character, dt), meas=names(dt.char))[, {

  tabula = setDT(list(value))[, .N, by="V1"][order(-N, V1)]

  .(
    NOBS  = .N,
    NNA   = sum(is.na(value)),
    NVALS = nrow(tabula),
    HIVAL = tabula$V1[1L],
    NHI   = tabula$N[1L]
  )
}, by=variable]

#    variable NOBS NNA NVALS HIVAL NHI
# 1:     var1    5   0     3     a   2
# 2:     var3    5   1     4   low   2

Чтобы исключить NA как категорию (отображается в NVALS и, возможно, HIVAL, NHI), измените [, .N, by="V1"] на [!is.na(V1), .N, by="V1"] выше.

Я сомневаюсь, что производительность важна для этой задачи, но это должно быть достаточно эффективным.

0 голосов
/ 25 июня 2018

Это должно сделать это: 

analyze_all_char <- function(dt) {
  dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
  mylist = lapply(1:length(dt.char), function(i) {
    x = dt.char[,i,with=FALSE]
    analyze_char_var(x)
  })
  return(mylist)
}

Бенчмаркинг это, вы не увидите слишком большого прироста производительности. Если вы после выступления, я бы посоветовал выполнить вычисления с data.table операциями.

Я увеличил data.frame и проверил решение for-loop, lapply и @ Frank. Чистый победитель - data.table! 

Unit: milliseconds
    expr      min       lq     mean   median       uq      max neval cld
 forloop 4.070700 4.685024 7.220436 6.709425 8.564480 35.81166   500   b
  lapply 3.988765 4.750347 7.367764 6.815147 8.613754 56.58692   500   b
 lapply1 4.008022 4.728257 7.390874 6.786074 8.551453 51.31551   500   b
     dtf 2.984400 3.320825 5.451909 4.699372 6.661660 40.85501   500  a

Полный код: 

dt = data.table(
  var1 = rep(c('a', 'a', 'b','b', 'c'),100),
  var2 = rep(1:5,100),
  var3 = rep(c('low','low','high','med',NA),100)
)

analyze_all_char <- function(dt) {
  dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
  mylist = list()
  for (i in 1:length(dt.char)){
    x = dt.char[,i,with=FALSE]
    mylist[[i]] = analyze_char_var(x)
  }
  return(mylist)
}
analyze_all_char_l <- function(dt) {
  dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
  mylist = lapply(1:length(dt.char), function(i) {
    x = dt.char[,i,with=FALSE]
    analyze_char_var(x)
  })
  return(mylist)
}
analyze_all_char_l1 <- function(dt) {
  dt.char = dt[,sapply(dt,class)=="character", with=FALSE]
  mylist = lapply(1:length(dt.char), function(i) {
    analyze_char_var(dt.char[,i,with=FALSE])
  })
  return(mylist)
}
dtf <- function() {
  melt(dt.char <- Filter(is.character, dt), meas=names(dt.char))[, {
    tabula = setDT(list(value))[, .N, by="V1"][order(-N, V1)]
    .(
      NOBS  = .N,
      NNA   = sum(is.na(value)),
      NVALS = nrow(tabula),
      HIVAL = tabula$V1[1L],
      NHI   = tabula$N[1L]
    )
  }, by=variable]
}

analyze_all_char(dt)
analyze_all_char_l(dt)
analyze_all_char_l1(dt)
dtf()

library(microbenchmark)
mc <- microbenchmark(times=500,
  forloop = analyze_all_char(dt),
  lapply = analyze_all_char_l(dt),
  lapply1 = analyze_all_char_l1(dt),
  dtf = dtf()
)
mc
...