2014-03-06 85 views
2

如何從Hmisc中彙總輸出,並以正確的格式將其呈現在knitr中,並且最好以合作伙伴的表格的形式傳輸給Word?R markdown v2和Hmisc表格

以下塊生成一個表,但是格式化關閉(所有的值標籤和號碼的變量在同一行,而不是下對方)

--- 
output: word_document 
--- 


```{r table, results='asis'} 
library(Hmisc) 
options(digits=3) 
set.seed(173) 
sex <- factor(sample(c("m","f"), 500, rep=TRUE)) 
age <- rnorm(500, 50, 5) 
treatment <- factor(sample(c("Drug","Placebo"), 500, rep=TRUE)) 

# Generate a 3-choice variable; each of 3 variables has 5 possible levels 
symp <- c('Headache','Stomach Ache','Hangnail', 
      'Muscle Ache','Depressed') 
symptom1 <- sample(symp, 500,TRUE) 
symptom2 <- sample(symp, 500,TRUE) 
symptom3 <- sample(symp, 500,TRUE) 
Symptoms <- mChoice(symptom1, symptom2, symptom3, label='Primary Symptoms') 
table(Symptoms) 

# Note: In this example, some subjects have the same symptom checked 
# multiple times; in practice these redundant selections would be NAs 
# mChoice will ignore these redundant selections 

#Frequency table sex*treatment, sex*Symptoms 
summary(sex ~ treatment + Symptoms, fun=table) 
``` 
+0

不是一個簡單的問題...好像[Gmisc :: HTMLTABLE(http://gforge.se/gmisc /)可以幫助,另一個例子[這裏](http://timelyportfolio.blogspot.com/2013/04/tables-are-like-cockroaches.html) – Ben

回答

2

我的主要重點是獲得summary.formula.reverse來自Hmisc的表格提交到word中。我傾向於使用它很多,所以我最終得到了一個快速入侵,使得表格變成了單詞 - 儘管沒有使用knitr。隨意提高,並應用相同的邏輯來其他summary.formula表...

library(stringr) 
library(Hmisc) 
library(rtf) 
tabl<-function(x,filename="tab.doc"){ 

    u<-capture.output(print(x,exclude1=F,long=T,pctdig=1,)) 

    col<-max(str_count(string=u,"\\|")) 
    row<-sum(as.numeric(str_detect(u,"\\|")==T)) 
    su<-which(str_detect(u,"\\|")==T) 
    i<-str_trim(unlist(str_split(u[su[1]],"\\|"))) 
    i2<-str_trim(unlist(str_split(u[su[2]],"\\|"))) 
    i3<-paste(i,i2,sep="\n") 
    i3<-i3[-c(1,col+1)] 
    uo<-u[su[-c(1:2)]] 
    val<-lapply(uo,function(x) str_trim(unlist(str_split(x,"\\|")))) 
    misd<-lapply(val,function(x) ifelse(x[3]=="",paste("\\tab",x[2],sep=" "),paste("\\ql",x[2],sep=" "))) 

    f<-t(matrix(unlist(val),col+1)) 
    f[,-c(1,col+1)]->f2 
    f2[,1]<-unlist(misd) 
    colnames(f2)<-i3 
    which(str_detect(f2,"\\ql")==T)->blank 
    inser<-function(df,place,vector){ 
    df1<-rbind(df[1:place-1,],vector,df[place:length(df[,1]),]) 
    df1 
    } 


    f3<-as.data.frame(f2) 
    lapply(c(1:length(names(f3))),function(x) levels(f3[[x]])<<-c(levels(f3[[x]]),"")) 
    g<-1 
    for (i in blank[-1]) { 
    f3<-inser(f3,i-1+g,c(rep("",col-1))) 
    g<-g+1 
    } 

    y<-as.data.frame(f3) 
    di<-apply(y,2,function(x) max(nchar(x)))/12 ##12 char/inch 
    di[di<.5]<-.5 
    u<-RTF(file=filename,width=8.5, height=11, omi=c(1, 1, 1, 1), font.size=10) 
    addHeader(u,title="Table",subtitle=paste(date(),"\n",sep="")) 
    addTable(u,y,font.size=10,row.names=FALSE,NA.string="-",col.justify = c("L",rep("C",col-2)),header.col.justify = c("L",rep("C",col-2)),col.widths=di) 
    done(u) 
    return(u) 
}