代码之家 › 专栏 › 技术社区 › Gaurav Singhal

无法对data.table使用lapply

summarization lapply data.table r

Gaurav Singhal · 技术社区 · 7 年前

我试图在DATA表中创建所有字符变量的摘要。基本上是为了得到观察总数,缺失值,频率最高的类别等等,但是我不能正确使用 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,然后使用 搭接 以数据帧的方式。

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 回复 | 直到 7 年前

Frank 7 年前

我试图在DATA表中创建所有字符变量的摘要。基本上是为了得到观测总数,缺失值,频率最高的类别等。

因为所有感兴趣的都有相同的类型,你可以使用 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"] 上面。

我怀疑性能对这项任务很重要,但这应该是相当有效的。

SeGa 7 年前

这应该做到:

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循环、lapply和@frank的解决方案。明确的赢家是 数据表 啊!

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