Подтвердить что ты не робот

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

Изменить: построив ответ 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 и 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")
4b9b3361

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

enter image description here

Ответ 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}

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

enter image description here

Очевидно, что я жестко закодировал честный материал, и могут быть более легкие способы создания кадра данных, в результате которого вы переходите на 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