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:







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