Графы и проценты в xTable, Sweave, R, cross tabulations

Question

Редактировать: Создав ответ aL3xa ниже, я изменил его синтаксис ниже. Не идеально, но все ближе. Я до сих пор не нашел способ сделать xxtable accept \ 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 библиотеку и почти работает, но не является динамическим и довольно некрасиво работать:

#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") 

Answer 1

Мне не удалось выяснить, как сгенерировать заголовок нескольких столбцов с помощью 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 = " ") 
    )) 
} 
@ 

Answer 2

Как бы эта работа для вас?

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) 

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

Редактировать: Просто подумал о хорошем решении, которое поможет вам ближе. После создания 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 значения

Answer 3

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

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

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 совместимым. Это 3AM в моем часовом поясе, поэтому с этими строками я закончу свой ответ:

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

Cheers!

Answer 4

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

Answer 5

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 

Answer 6

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} 

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

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

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

Answer 7

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

# 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, вы получите это (можно кастомизировать):