Как запустить табличную функцию в R для нескольких переменных и скомпилировать результаты в новый набор данных с помощью функции?

Question

У меня есть набор данных из примерно 100 переменных, и я хотел бы построить таблицу со сводками примерно из 30 этих переменных. Чтобы сделать это, я вручную запустил таблицу и другие функции для этих переменных и обработал результаты. Однако, поскольку мне нужно сделать это для 30+ переменных, я хотел бы автоматизировать процесс с помощью функции.

Вот пример набора данных:

df <- data.frame(v1=c('a','b','c','c','b'),v2=c('d','d','e','e','e'),cat=c('1low','1low','2med','3high','2med'))

Цель состоит в том, чтобы создать таблицу, подобную приведенной ниже (без NA).

Ниже приведен мой код:

library(formattable)

# For var1 & var2, apply the table function and convert to dataframe so that the row labels are incorporated into dataset
var1.df <- as.data.frame(table(df$v1, df$cat))

# reshape to achive wide format (goal to view the count of each var1 level across low, med, high cats)
var1.df <- reshape(var1.df, idvar = "Var1", timevar = "Var2", direction = "wide")

# add col names
names(var1.df) <- c("vcat","low","med","high"); var1.df

# repeat above steps for next variable. in true dataset, I will need to repeat for 30 vars...
var2.df <- as.data.frame(table(df$v2, df$cat))
var2.df <- reshape(var2.df, idvar = "Var1", timevar = "Var2", direction = "wide")
names(var2.df) <- c("vcat","low","med","high")

# Create variable headings
var1.heading <- data.frame("variable 1",NA,NA,NA) # ideally, the NAs are blanks
names(var1.heading) <- c("vcat","low","med","high")

var2.heading <- data.frame("variable 2","","","")
names(var2.heading) <- c("vcat","low","med","high")

# Rbind the category headings and the table result data
table01 <- do.call("rbind", list(var1.heading, var1.df, 
                                 var2.heading, var2.df))

# Format the table for presentation
heading.list <- c("variable 1", "variable 2")
x <- formattable(table01, 
                 align =c("l","c","c","c","c"),
                 list(vcat = formatter("span", style = x ~ ifelse(x %in% heading.list, 
                                                                  style(font.weight = "bold"), NA))))

Мои приведенные ниже попытки автоматизировать приведенный выше код либо не завершены (a), либо не выполняются должным образом (b)

# (a)
lapply(df, function(x) as.data.frame(table(x, df$cat)))

# (b)
myfxn <- function(x){
  y <- as.data.frame(table(x, df$cat))
  y <- reshape(y, idvar = "x", timevar = "Var2", direction = "wide")
  names(y) <- c("vcat","low","med","high")
}
lapply(df, myfxn(x))

Есть предложения, как мне автоматизировать этот процесс для еще нескольких переменных? Кроме того, есть ли другой способ вставки заголовков категорий в таблицу, кроме ручного создания вставки однострочного кадра данных? Обратите внимание, что я вставил NA в var1.heading, так как это первый фрейм данных; Когда я пытался вставить "" вместо пробелов (например, var2.heading), последующие кадры данных не связывались, потому что они были факторами, а не символами. Заранее большое спасибо!

Answer 1

Я бы начал с твоей попытки b, так как она была очень близка. Я думаю, что единственная причина, по которой вы меняете форму, заключается в том, что data.frame(table(), что вам не нужно делать, если вы отбрасываете класс "table" из table s.

Я бы также попытался завершить всю манипуляцию для одной переменной в функции ie, добавление заголовков, меток и т. д. c. Таким образом, вы можете проверить свою функцию на одной переменной, чтобы убедиться, что она делает именно то, что вы хотите, а затем начать l oop по всем переменным.

# (b)
myfxn <- function(x, header = 'variable') {
  y <- unclass(table(x, df$cat))
  colnames(y) <- gsub('\\d', '', colnames(y))
  y <- data.frame(vcat = rownames(y), y, stringsAsFactors = FALSE)
  rbind(c(header, rep('', ncol(y) - 1)), y)
}

myfxn(df$v1)
#       vcat low med high
# 1 variable             
# a        a   1   0    0
# b        b   1   1    0
# c        c   0   1    1

Далее, я бы использовал Map или mapply вместо lapply для передачи нескольких аргументов myfxn

l <- Map(myfxn, df[-3], heading.list)

formattable(
  do.call('rbind', l), row.names = FALSE,
  align = c('l', rep('c', nlevels(df$cat))),
  list(
    vcat = formatter('span', style = x ~ ifelse(x %in% heading.list, style(font.weight = 'bold'), NA))
  )
)

## apply for 30 variables
heading.list <- sprintf('variable %s', 1:30)
l <- Map(myfxn, df[sample(1:2, 30, TRUE)], heading.list)

formattable(
  do.call('rbind', l), row.names = FALSE,
  align = c('l', rep('c', nlevels(df$cat))),
  list(
    vcat = formatter('span', style = x ~ ifelse(x %in% heading.list, style(font.weight = 'bold'), NA))
  )
)