2017-06-04 44 views
1
> dput(mydat) 
structure(list(Q1 = c(0, 1, NA, 1), Q2 = c(0, 1, 1, 1), Q3 = c(1, 
NA, 1, 1), Gender = structure(c(2L, 2L, 1L, 1L), .Label = c("F", 
"M"), class = "factor"), Type = c("A", "A", "A", "B")), .Names = c("Q1", 
"Q2", "Q3", "Gender", "Type"), row.names = c(NA, -4L), class = "data.frame") 

> mydat 
    Q1 Q2 Q3 Gender Type 
1 0 0 1  M A 
2 1 1 NA  M A 
3 NA 1 1  F A 
4 1 1 1  F B 

我有一個包含3個問題和2個人​​口統計變量的data.frame。我寫了一個函數來輸出一個彙總表。在LaTeX中生成意外事件彙總表

myfun <- function(from, to){ 
    tt = t(rowsum(mydat[from:to], mydat$Gender, na.rm = TRUE)) 
    ptt = prop.table(tt, 2) 
    fish = fisher.test(tt, simulate.p.value = TRUE) 
    tt2 = t(rowsum(mydat[from:to], mydat$Type, na.rm = TRUE)) 
    ptt2 = prop.table(tt2, 2) 
    fish2 = fisher.test(tt2, simulate.p.value = TRUE) 
    list(rbind(cbind(Female = tt[, 1], ptt[, 1], Male = tt[, 2], ptt[, 2], 
          A = tt2[, 1], ptt2[, 1], B = tt2[, 2], ptt2[, 2]), 
       c(fish$p.value, NA, NA, NA, fish2$p.value, NA, NA, NA))) 
} 

tab = myfun(1, 2) 
>tab 

[[1]] 
    Female   Male  A   B  
Q1  1 0.3333333 1 0.5 1 0.3333333 1 0.5 
Q2  2 0.6666667 1 0.5 2 0.6666667 1 0.5 
     1  NA NA NA 1  NA NA NA 

該功能需要2個參數(from,to)來告訴功能我要選擇的問題。在我的例子中,我選擇了問題1和2.我希望函數輸出一個計數及其相應的比例。表格的最後一行是一個p值,反映了問題和人口變量(性別或類型)之間的關聯。

xtable(data.frame(tab)) 

調用上面的函數提供了以下的LaTeX表:

enter image description here

我要的是:

enter image description here

凡在本表中的條目顯示爲count (proportion)在每個單元格中,而不是具有單獨的比例列。有沒有更有效的方法來做到這一點?在Hmisc也許?

+0

您可以檢查'表:: tabfreq '。 – Henrik

回答

0

下面是使用knitr,xtable和tabularX包一個答案。

的tabularX包將確保文檔的寬度由X列填充。它在print.xtable方法中使用tabular.environment = "tabularx"width="\\textwidth"選項調用,我使用選項align(xt)<-c("l","X","X","X","X"),以便我的X列寬度跨越頁面的剩餘寬度。

在你的榜樣,你要貼兩個值(數字和概率),這是通過簡單地調用str_c(str_c(tt[, 1]," (",ptt[, 1],")")完成,str_c()就像paste()但默認情況下,分隔符爲「」。創建data.frame時,將重複唯一值「)」和「)」以匹配表的行數。

主要問題是最後一行只有兩列。所以我使用xtable的add.to.row參數來定義一個習慣的行。我指定要在哪一行添加自定義值,這裏是最後一行(第2行),因此addtorow$pos[[1]] <- 2,然後我添加一個參數說明該行將跨越兩列。

addtorow$command <- str_c(" p-Value & \\multicolumn{2}{c}{",fish$p.value,"} & \\multicolumn{2}{c}{", fish2$p.value,"} \\\\\n") 

正如我在做這個功能裏面,我返回兩個元素的列表,第一個是表,第二個參數add.to.row。

所以最後,我的表是這樣的:

% latex table generated in R 3.4.2 by xtable 1.8-2 package 
% Mon Oct 30 21:50:04 2017 
\begin{table}[ht] 
\centering 
\begin{tabularx}{\textwidth}{lXXXX} 
    \hline 
& Female & Male & A & B \\ 
    \hline 
1 & 1 (0.33) & 1 (0.5) & 1 (0.33) & 1 (0.5) \\ 
    2 & 2 (0.67) & 1 (0.5) & 2 (0.67) & 1 (0.5) \\ 
    p-Value & \multicolumn{2}{c}{1} & \multicolumn{2}{c}{1} \\ 
\hline 
\end{tabularx} 
\end{table} 

產生

table with two different row length

這裏是knitr代碼:

\documentclass{article} 
\title{Test example for table with different row length} 
\usepackage{tabularx} 
\date{} % no date 
\begin{document} 
\maketitle{} 


<<init, echo = FALSE, results = 'hide'>>= 
require(stringr) 
require(xtable) 
@ 

<<table_example, echo = FALSE, results = 'hide'>>= 
require(stringr) 
require(xtable) 
mydat <- structure(list(Q1 = c(0, 1, NA, 1), Q2 = c(0, 1, 1, 1), Q3 = c(1, NA, 1, 
       1), Gender = structure(c(2L, 2L, 1L, 1L), .Label = c("F", "M"), class = "factor"), 
      Type = c("A", "A", "A", "B")), .Names = c("Q1", "Q2", "Q3", "Gender", "Type"), 
    row.names = c(NA, -4L), class = "data.frame") 

myfun <- function(from, to) { 
    tt <- t(rowsum(mydat[, from:to], mydat$Gender, na.rm = TRUE)) 
    ptt <- round(prop.table(tt, 2), 2) 
    fish <- fisher.test(tt, simulate.p.value = TRUE) 
    tt2 <- t(rowsum(mydat[, from:to], mydat$Type, na.rm = TRUE)) 
    ptt2 <- round(prop.table(tt2, 2), 2) 
    fish2 <- fisher.test(tt2, simulate.p.value = TRUE) 
    df <- data.frame(Female = str_c(tt[, 1], " (", ptt[, 1], ")"), Male = str_c(tt[, 
         2], " (", ptt[, 2], ")"), A = str_c(tt2[, 1], " (", ptt2[, 1], ")"), B = str_c(tt2[, 
         2], " (", ptt2[, 2], ")")) 
    addtorow <- list() 
    addtorow$pos <- list() 
    addtorow$pos[[1]] <- 2 
    addtorow$command <- str_c(" p-Value & \\multicolumn{2}{c}{", fish$p.value, "} & \\multicolumn{2}{c}{", 
     fish2$p.value, "} \\\\\n") 
    return(list(df = df, addtorow = addtorow)) 
} 
tab = myfun(1, 2)$df 
addtorow = myfun(1, 2)$addtorow 
xt <- xtable(tab) 
align(xt) <- c("l", "X", "X", "X", "X") 
print.xtable(x = xt, file = "test_table_out.tex", tabular.environment = "tabularx", 
    width = "\\textwidth", add.to.row = addtorow) 
@ 
\input{test_table_out.tex} 
\end{document}