Подсчеты и проценты в таблицах xTable, Sweave, R, кросс-табуляции - PullRequest
15 голосов
/ 10 августа 2010

Редактировать: Основываясь на ответе aL3xa ниже, я изменил его синтаксис ниже.Не идеально, но все ближе.Я до сих пор не нашел способ заставить xtable принимать аргументы \ multicolumn {} для столбцов или строк.Также кажется, что Hmisc выполняет некоторые из этих типов задач за кулисами, но это кажется чем-то вроде понимания того, что там происходит.У кого-нибудь есть опыт работы с функцией латекса в Hmisc?

ctab <- function(tab, dec = 2, margin = NULL) {
    tab <- as.table(tab)
    ptab <- paste(round(prop.table(tab, margin = margin) * 100, dec), "%", sep = "")
    res <- matrix(NA, nrow = nrow(tab) , ncol = ncol(tab) * 2, byrow = TRUE)
    oddc <- 1:ncol(tab) %% 2 == 1
    evenc <- 1:ncol(tab) %% 2 == 0
    res[,oddc ] <- tab
    res[,evenc ] <- ptab
    res <- as.table(res)
    colnames(res) <- rep(colnames(tab), each = 2)
    rownames(res) <- rownames(tab)
    return(res)
}

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

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

Сначала несколько примеров данных:

#Generate sample data
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))

А теперь рабочиефункция прямой табуляции:

customTable <- function(var, capt = NULL){
    counts <- table(var)
    percs <- 100 * prop.table(counts)       

    print(
        xtable(
            cbind(
                Count = counts
                , Percent = percs
            )
        , caption = capt
        , digits = c(0,0,2)
        )
    , caption.placement="top"
    )
}

#Usage
customTable(dow, capt="Day of Week")
customTable(purp, capt="Trip Pupose")

Есть ли у кого-нибудь предложения принять это для перекрестных таблиц (т. е. день недели в целях поездки)?Вот то, что я в настоящее время написал, который НЕ использует библиотеку xtable, и ALMOST работает, но не является динамическим и довольно уродливым для работы:

#Create table and percentages
a <- table(dow, purp)
b <- round(prop.table(a, 1),2)

#Column bind all of the counts & percentages together, this SHOULD become dynamic in future
d <- cbind( cbind(Count = a[,1],Percent =  b[,1])
        , cbind(Count = a[,2], Percent = b[,2])
        , cbind(Count = a[,3], Percent = b[,3])
        , cbind(Count = a[,4], Percent = b[,4])
)

#Ugly function that needs help, or scrapped for something else
crossTab <- function(title){
    cat("\\begin{table}[ht]\n")
    cat("\\begin{center}\n")
    cat("\\caption{", title, "}\n", sep="") 

    cat("\\begin{tabular}{rllllllll}\n")
    cat("\\hline\n")

    cat("", cat("", paste("&\\multicolumn{2}{c}{",colnames(a), "}"), sep = ""), "\\\\\n", sep="")
    c("&", cat("", colnames(d), "\\\\\n", sep=" & "))
    cat("\\hline\n")
    c("&", write.table(d, sep = " & ", eol="\\\\\n", quote=FALSE, col.names=FALSE))

    cat("\\hline\n")
    cat("\\end{tabular}\n")
    cat("\\end{center}\n")
    cat("\\end{table}\n")   
}   

crossTab(title = "Day of week BY Trip Purpose")

Ответы [ 7 ]

12 голосов
/ 07 мая 2013

В Таблице-пакете это одна строка:

# data:
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))

dataframe <-  data.frame( dow, purp)

# The packages

library(tables)
library(Hmisc)

# The table
tabular(  (Weekday=dow) ~  (Purpose=purp)*(Percent("row")+ 1)    ,data=dataframe        )

# The latex table
latex(  tabular(  (Weekday=dow) ~  (Purpose=purp)*(Percent("col")+ 1)    ,data=dataframe        ))

Используя booktabs, вы получаете это (может быть дополнительно настроено):

enter image description here

7 голосов
/ 10 августа 2010

Отличный вопрос, этот меня беспокоит некоторое время (это не , что трудно, просто я чертовски ленив ... как обычно). Однако ... хотя вопрос велик, я боюсь, что ваш подход - нет. Есть бесценный пакет под названием xtable, который вы можете (не использовать). Кроме того, эта проблема слишком распространена - есть большой шанс, что уже есть какое-то готовое решение, которое находится где-то на в Интернете .

На днях я собираюсь решить это раз и навсегда (я выложу код на GitHub). Основная идея выглядит примерно так: хотите ли вы, чтобы значения частоты и / или процента в пределах одной ячейки (разделенных \) или строк с абсолютными и относительными частотами (или%) подряд? Я бы выбрал вариант 2 nd , поэтому сейчас я опубликую решение по оказанию первой помощи:

ctab <- function(tab, dec = 2, ...) {
  tab <- as.table(tab)
  ptab <- paste(round(prop.table(tab) * 100, dec), "%", sep = "")
  res <- matrix(NA, nrow = nrow(tab) * 2, ncol = ncol(tab), byrow = TRUE)
  oddr <- 1:nrow(tab) %% 2 == 1
  evenr <- 1:nrow(tab) %% 2 == 0
  res[oddr, ] <- tab
  res[evenr, ] <- ptab
  res <- as.table(res)
  colnames(res) <- colnames(tab)
  rownames(res) <- rep(rownames(tab), each = 2)
  return(res)
}

Теперь попробуйте что-то вроде:

data(HairEyeColor)           # load an appropriate dataset
tb <- HairEyeColor[, , 1]    # choose only male respondents
ctab(tb)
      Brown  Blue   Hazel Green
Black 32     11     10    3    
Black 11.47% 3.94%  3.58% 1.08%
Brown 53     50     25    15   
Brown 19%    17.92% 8.96% 5.38%
Red   10     10     7     7    
Red   3.58%  3.58%  2.51% 2.51%
Blond 3      30     5     8    
Blond 1.08%  10.75% 1.79% 2.87%

Убедитесь, что вы загрузили xtable пакет и используете print (это универсальная функция, поэтому вы должны передать классифицируемый объект xtable). Важно, чтобы вы подавили имена строк. Я оптимизирую этот завтра - он должен быть xtable совместимым. Сейчас 3 часа утра в моем часовом поясе, поэтому на этих строках я закончу свой ответ:

print(xtable(ctab(tb)), include.rownames = FALSE)

Ура!

4 голосов
/ 17 июня 2012

Использование multicolumn с latex из пакета Hmisc не так уж плохо. Этот минимальный документ Sweave:

\documentclass{article}
\begin{document}

<<echo = FALSE,results = tex>>=
library(Hmisc)
dow <- sample(1:7, 100, replace=TRUE)
purp <- sample(1:4, 100, replace=TRUE)
dow <- factor(dow, 1:7, c("Mon", "Tues", "Wed", "Thurs", "Fri", "Sat", "Sun"))
purp <- factor(purp, 1:4, c("Business", "Commute", "Vacation", "Other"))
tbl <- table(dow,purp)
tbl_prop <- round(100 * prop.table(tbl,1),2)

tbl_df <- as.data.frame.matrix(tbl)
tbl_prop_df <- as.data.frame.matrix(tbl_prop)
colnames(tbl_prop_df) <- paste(colnames(tbl_prop_df),"1",sep = "")
df <- cbind(tbl_df,tbl_prop_df)[,ggplot2:::interleave(1:4,5:8)]
colnames(df) <- rep(c('n','\\%'),times = 4)

latex(object=df,file="",cgroup = colnames(tbl_df),
      colheads = NULL,rowlabel = "",
      center = "centering",collabel.just = rep("r",8))
@

\end{document}

Производит это для меня:

enter image description here

Очевидно, я жестко запрограммировал немало вещей, и могут быть более изощренные способы создания фрейма данных, который вы в конечном итоге передаете latex, но это должно по крайней мере дать начало, используя multicolum .

Также, небольшая ошибка, я использовал функцию ggplot2 interleave при объединении чисел и процентов для чередования столбцов. Это потому, что я ленивый.

4 голосов
/ 12 августа 2010

Я не смог выяснить, как создать заголовок из нескольких столбцов, используя xtable, но я действительно понял, что могу объединить мои подсчеты и проценты в один столбец для печати.Не идеально, но похоже, что работа сделана.Вот функция, которую я написал:

ctab3 <- function(row, col, margin = 1, dec = 2, percs = FALSE, total = FALSE, tex = FALSE, caption = NULL){
    tab <- as.table(table(row,col))
    ptab <- signif(prop.table(tab, margin = margin), dec)

    if (percs){

        z <- matrix(NA, nrow = nrow(tab), ncol = ncol(tab), byrow = TRUE) 
        for (i in 1:ncol(tab)) z[,i] <- paste(tab[,i], ptab[,i], sep = " ")
        rownames(z) <- rownames(tab)
        colnames(z) <- colnames(tab)

        if (margin == 1 & total){
            rowTot <- paste(apply(tab, 1, sum), apply(ptab, 1, sum), sep = " ")
            z <- cbind(z, Total = rowTot)
        } else if (margin == 2 & total) {
            colTot <- paste(apply(tab, 2, sum), apply(ptab, 2, sum), sep = " ")
            z <- rbind(z,Total = colTot)
        }
    } else {
        z <- table(row, col)    
    }
ifelse(tex, return(xtable(z, caption)), return(z))
}

Возможно, не конечный продукт, но допускает некоторую гибкость в параметрах.На самом базовом уровне это только оболочка table(), но она также может генерировать вывод в формате LaTeX.Вот что я использовал в документе Sweave:

<<echo = FALSE>>=
for (i in 1:ncol(df)){
    print(ctab3(
        col = df[,1]
        , row = df[,i]
        , margin = 2
        , total = TRUE
        , tex = TRUE
        , caption = paste("Dow by", colnames(df[i]), sep = " ")
    ))
}
@
1 голос
/ 10 августа 2010

Как это будет работать для вас?

library(reshape)
library(plyr)
df <- data.frame(dow = dow, purp = purp)

df.count <- count(df)
df.count <- ddply(df.count, .(dow), transform, p = round(freq / sum(freq),2))

df.m <- melt(df.count)

df.print <- cast(df.m, dow ~ purp + variable)

library(xtable)
xtable(df.print)

Это не дает хороших многоколонок, и у меня недостаточно опыта с xtable, чтобы понять, возможно ли это. Однако, если вы собираетесь писать собственные функции, вы можете попробовать ту, которая работает с именами столбцов df.print. Возможно, вам даже удастся написать один достаточно общий, чтобы в качестве входных данных были использованы всевозможные преобразованные кадры данных.

Edit: Просто подумал о хорошем решении, чтобы приблизить вас. После создания df.m

df.preprint <- ddply(df.m, .(dow, purp), function(x){
        x <- cast(x, dow ~ variable)
        x$value <- paste(x$freq, x$p, sep = " / ")
        return(c(value = x$value))
     }
)

df.print <- cast(df.preprint, dow ~ purp)

print(xtable(df.print), include.rownames = F)

Теперь каждая ячейка будет содержать N / percent значений

0 голосов
/ 16 июня 2012
tab<-table(row, col)
ctab<-round(100*prop.table(tab,2), 2) # for column percents (see the args for prop.table)

for (i in 1:length(tab)) {
  ctab[i]<-paste(tab[i]," (", ctab[i], "%", ")", sep="")
}

require(xtable);
k<-xtable(ctab,digits=1) # make latex table
0 голосов
/ 03 января 2012

Я понимаю, что этот поток немного староват, но функция tableNominal () в пакете reporttools может обеспечить нужную вам функцию.

...