CODEWITHSUNDEEP
rr-markdownhmisc
Misha
Misha

Reputation: 3126

R markdown v2 and Hmisc tables

How can I take the output from summary in Hmisc and have it rendered in knitr with the correct formatting and preferably transferred to word as a table for my collaborators?

The following chunk produces a table but the formatting is off (all the value labels and numbers for the variables are on the same line, not beneath each other)

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

Upvotes: 3

Views: 1014

Answers (1)

Misha
Misha

Reputation: 3126

My main focus was to get the summary.formula.reverse table from Hmisc into word for submission. I tend to use it a lot so I ended up with a quick hack that gets the table into word - although not using knitr. Feel free to improve and apply the same logic to the other summary.formula tables...

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

Upvotes: 2

Related Questions