R markdown v2 和 Hmisc 表

Question

我如何从 Hmisc 中获取摘要的输出，并以正确的格式在 knitr 中呈现，并最好将其传输到 word 作为协作者的表格？

下面的 block 生成了一个表格，但格式是关闭的(变量的所有值标签和数字都在同一行上，而不是在彼此下面)

---
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)
``` 

Answer 1

我的主要工作是将 Hmisc 中的 summary.formula.reverse 表导入到 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)
}