Блестящий - Генерация кросс-таблицы с итогом столбца и итогом строки в качестве 1-й строки / столбца

Я хочу создать перекрестную таблицу с итоговым столбцом для строки и столбца. Я попытался сгенерировать кросс-таблицу с помощью пакета gmodels. Внешний вид вывода лучше, чем обычная табличная функция. Внешний вид таблицы важен, так как в конечном итоге он должен отображаться с помощью Shiny. Но проблема в том, что я получаю общее количество столбцов и общее количество строк в конце строк и столбцов. Как я могу получить общий столбец в качестве 1-го столбца и строки в таблице.

Ниже приведен образец моих данных.

Location <- sample(c("location A","location B","location C","location D","location E"),20,replace = T) 
Brand <- sample(c("Brand A","Brand B","Brand C"),20,replace = T) 
Year <- rep(c("Year 2014","Year 2015"),10)
Q1 <- sample(1:5,20,replace = T)
Q2 <- sample(1:5,20,replace = T)

mydata <- as.data.table(cbind(Location,Brand,Year,Q1,Q2))

Данные огромны и, следовательно, это data.table.

Код, который я использую для создания кросс-таблицы:

library("gmodels")

mydata[,CrossTable(Location,Brand,prop.c = T,prop.r = F,prop.t = F,prop.chisq = F,chisq = F,format = "SPSS")]

Это дает вывод, но общее количество столбцов находится в конце строки и конце столбца. Также отсутствует столбец% для общего столбца. Как я могу иметь итоговые столбцы в качестве 1-й строки и столбца, а также иметь% для этого?

Предложите выход.

2 ответа

Решение

Вы пытались использовать пакет sjPlot... он имеет очень хорошую функцию, sjt.xtab, которая генерирует кросс-таблицы (таблицы сопряженности), аналогичные тому, что вы ищете. У этого есть много вариантов, чтобы исследовать. Я использовал несколько из них ниже. Вы можете посмотреть файл? Sjt.xtab и увидеть другие доступные опции. Код ниже генерирует вывод таблицы с процентами столбцов и имеет общий столбец и строки.

sjt.xtab(mydata$Location, mydata$Brand,
         show.col.prc = T,
         show.summary = F,
         show.na = F,
         wrap.labels = 50,
         tdcol.col = "#f90470",
         emph.total = T,
         emph.color = "#3aaee5",
         use.viewer = T,
         CSS = list(css.table = "border: 1px solid;",
                    css.tdata = "border: 1px solid;"))

Может быть, что-то подобное может сделать?

myCT <- function(mydata) {
  mydata_ct_n <- dcast.data.table(mydata, Location ~ Brand, margins = T)
  mydata_ct_n[, all := rowSums(.SD), by = Location]
  mydata_ct_n <- rbind(mydata_ct_n[, lapply(.SD, sum), .SDcols = 2:ncol(mydata_ct_n)], mydata_ct_n, fill = T)
  mydata_ct_n$Location[1] <- "all"
  foocols <- c("all", "Location")
  setcolorder(mydata_ct_n, c(foocols, setdiff(colnames(mydata_ct_n), foocols)))

  mydata_ct_p <- copy(mydata_ct_n)
  for (j in 3:ncol(mydata_ct_p)) {
    set(mydata_ct_p, j = j, value = as.numeric(mydata_ct_p[[j]]))
    set(mydata_ct_p, i = 2:nrow(mydata_ct_p), j = j, value = round(100 * mydata_ct_p[2:nrow(mydata_ct_p), j, with = F] / mydata_ct_p[[j]][1], 0))
  }
  set(mydata_ct_p, 1L, 3L:ncol(mydata_ct_p), round(100 * mydata_ct_p[1L, 3L:ncol(mydata_ct_p), with = F] / mydata_ct_p[["all"]][1], 0))

  for (j in 3:ncol(mydata_ct_p)) {
    set(mydata_ct_p, j = j, value = as.character(mydata_ct_p[[j]]))
    set(mydata_ct_n, j = j, value = as.character(mydata_ct_n[[j]]))
    set(mydata_ct_p, j = j, 
        value = paste0(mydata_ct_p[[j]], "% (", mydata_ct_n[[j]], ")"))
  }
  return(mydata_ct_p)
}

Location <- sample(c("location A","location B","location C","location D","location E"),20,replace = T)
Brand <- sample(c("Brand A","Brand B","Brand C"),20,replace = T)
Year <- rep(c("Year 2014","Year 2015"),10)
Q1 <- sample(1:5,20,replace = T)
Q2 <- sample(1:5,20,replace = T)
mydata <- as.data.table(cbind(Location,Brand,Year,Q1,Q2))

out <- myCT(mydata)
print(out)
#    all   Location Brand A Brand B Brand C
# 1:  20        all 30% (6) 35% (7) 35% (7)
# 2:   3 location A  0% (0) 43% (3)  0% (0)
# 3:   5 location B 33% (2) 14% (1) 29% (2)
# 4:   5 location C 50% (3)  0% (0) 29% (2)
# 5:   4 location D 17% (1) 29% (2) 14% (1)
# 6:   3 location E  0% (0) 14% (1) 29% (2)
Другие вопросы по тегам