R markdown v2 and Hmisc tables



我如何从HMISC中摘要中的输出,并在Knitr中使用正确的格式渲染,最好将其作为我的合作者的表格转移到Word上?

以下块会产生一个表,但格式已关闭(变量的所有值标签和数字都在同一条线上,而不是彼此下方)

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

我的主要重点是将summary.formula.forvers.forvers。我倾向于使用它很多,所以我最终得到了一个快速的黑客,尽管不使用knitr,但我最终将桌子变成了词。随意改进并将相同的逻辑应用于另一个摘要。表格表...

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

最新更新