Графы и проценты в xTable, Sweave, R, кросс-таблицы

Ответ 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 = " ")
    ))
}
@

Ответ 2

В Tables-пакете это одна строка:

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

Ответ 3

Великий вопрос, этот меня беспокоит какое-то время (это не так сложно, просто я ленив, как ад... как обычно). Однако... хотя вопрос большой, ваш подход, я боюсь, нет. Там бесценный пакет под названием 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 classed). Важно, чтобы вы подавляли имена строк. Я буду оптимизировать это завтра - он должен быть xtable совместим. Это 3AM в моем часовом поясе, поэтому с этими строками я закончу свой ответ:

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

Ура!

Ответ 4

Использование 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}

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

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

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

Ответ 5

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

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 значения

Ответ 6

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

Ответ 7

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