Temat: SAS Proc FREQ TABLES w R - przykładowe rozwiązanie

Dla rozruszania grupy chciałem podzielić się prostym, ale dającym miły dla oka efekt kodem, naśladującym wydruk SASowej procedury FREQ Tables. Nie ma w nim nic odkrywczego, ale może przyda się komuś, kto tak jak ja, musi uzyskać wydruk maksymalnie zbliżony do formatu SAS.

Wygląda to tak:

Obrazek


Obrazek


Uruchamiamy spod RStudio, albo zapisujemy wynikowy strumień HTML do pliku, pamiętając o dołączeniu CSSa.

PS: nie miałem czasu aby dopieścić kwestię obsługi wielu różnych zmiennych podawanych w różny sposób
a$b, a[, "b"], a[[b]] etc
. Wszystkie zmienne należy podawać w notacji "dolarowej" i tylko do 3 poziomów zagłębienia. To co jest w zupełności wystarczy do moich potrzeb, więc nie było sensu robić na tym doktoratu. Być może jest prostszy sposób.

Test.rmd
---
output:
html_document:
css: styles.css
---
```{r}
library(xtable)
library(stringr)

# Dane testowe
sdtm <- list()
sdtm$EX <- data.frame(expdose=as.numeric(c(rep(25, 43), rep(50, 51), rep(75, 154), rep(100, 322), rep(NA, 24))),
expdoseu = c(rep("mg", 517), rep("Mg", 66), rep(NA, 11)))
comment(sdtm$EX$expdose) <- "Planned Dose"
```

```{r results='asis'}
ProcFREQTables <- function(variable, ...) {

# zbiór argumentów podanych do funkcji (bez jej nazwy)
variables <- as.character(as.list(match.call()[-1]))

invisible(sapply(variables, FUN=function(varName) {

# próba ustalenia "składowych ścieżki" do zmiennej: lista$ramka$kolumna, ramka$kolumna, zmienna atomowa
varNameComponents <- strsplit( varName, "$", fixed=TRUE)[[1]]
lst <- varNameComponents[1]
df <- varNameComponents[2]
col <- varNameComponents[3]

if(is.na(col)) {
if(is.na(df)) {
var <- .GlobalEnv[[lst]]
varName <- lst
} else {
var <- .GlobalEnv[[lst]][[df]]
varName <- df
}
} else {
var <- .GlobalEnv[[lst]][[df]][[col]]
varName <- col
}
varName <- toupper(varName)

label <- comment(var) # jak SASowy label

# Tabela częstości
tab <- data.frame(table(var))
tab <- tab[order(tab$Freq),]
tab$Freq <- sort(tab$Freq);
tab$Prop <- prop.table(tab$Freq)*100
tab$CumFreq <- cumsum(tab$Freq)
tab$CumProp <- cumsum(tab$Prop)
xtab <- xtable(tab)

# Drukujemy tabelę z odpowiednimi nagłówkami
cat("<P>") # paragraf dla zachowania odstępu między tabelami
result <- print(xtab, type="html",
print.results=F,
include.rownames=F,
include.colnames=F,
html.table.attributes="class='CrossTable'",
add.to.row=list(
pos=list(0, nrow(tab)),
command=c(
paste0( ifelse(is.null(label),
"<TR><TH>",
paste0("<TR><TH colspan=5>", label, "</TH></TR> <TR><TH>")
),
varName ,"</TH><TH>Frequency</TH><TH>Percent</TH><TH>Cumulative Frequency</TH><TH>Cumulative Percent</TH></TR>"
),
paste("<TR><TD colspan=5 class='Footer'>Frequency Missing =", sum(is.na(var)),"</TD></TR>")
)
)
)

# brzydki workaround, ponieważ stylowanie tagu "col" nie działa, zapewne z uwagi na colspan
result <- str_replace_all(result, "<TR> <TD>", "<TR> <TD class='GrayedColumn'>")
cat(result)
cat("</P>")
}))
}

ProcFREQTables(sdtm$EX$expdose, sdtm$EX$expdoseu)
```


styles.css. Poniższy kod należy dodać do standardowego CSSa RStudio

table {
....... różne opcje RStudio .....
max-width: 95%;
width:auto !important;
margin-left:auto !important;
margin-right:auto !important;
}

th {
.... formatowanie RStudio ....

font-size:12px;
background-color: white;
text-align:center;
max-width:100px;
width:auto;
}

td {
.... formatowanie RStudio ....

font-size:12px;
background-color:white;
max-width:100px;
width:auto;
}

.CrossTable {
border:1px solid rgb(176, 183, 187);
}

.CrossTable TD, .CrossTable TH {
border:1px solid rgb(176, 183, 187) !important;
padding: 4px;
font-family: Arial, Helvetica, sans-serif !important;
}

.CrossTable TH, .CrossTable .Footer, .CrossTable .GrayedColumn {
background-color: rgb(237, 242, 249);
color: rgb(17, 34, 119);
font-weight:bold;
}

.CrossTable .Footer {
text-align:center;
}


PS: przy okazji - gorąco zachęcam wszystkich do rozpoczęcia przygody z "reproducible research" i dokumentowania wszelkich swoich analiz w ten właśnie sposób. Do logowania kodu i podsumowań mamy do dyspozycji mamy: knitr / pandoc + RMarkdown + HTML + Latex, a do tworzenia finalnych dokumentów - ReporteRs (format OpenXML, tj. DOCX, PPTX, HTML5), odfWeave (OpenDocument) lub wspomniany knitr/sweave (PDF).Ten post został edytowany przez Autora dnia 26.11.14 o godzinie 01:26