Question

如何从Hmisc中获取摘要的输出并使用正确的格式在knitr中呈现它，并最好转换为单词作为我的协作者的表格？

下面的块会生成一个表，但格式化是关闭的（变量的所有值标签和数字都在同一行，而不是在彼此之下）

---
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表转换为提交单词。我倾向于使用它很多，所以我最终得到一个快速的黑客，使表格成为一个字 - 虽然不使用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)
}

R markdown v2和Hmisc表

1 个答案: