CODEWITHSUNDEEP
rr-markdownknitrpurrrsjplot
morphatic
morphatic

Reputation: 7975

Output a series of crosstabs using sjPlot into an RMarkdown document using knitr

I'm trying to use purrr::imap() to output a series of crosstab tables into a Flexdashboard. However, no matter what I try to output from the mapped function, all I get is an escaped HTML string instead of actual raw HTML.

I'm pretty new to R and RMarkdown.

Here's a minimal working example of what I'm talking about:

---
title: "Multiple Crosstabs Example"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

```{r setup, include=FALSE}
library(dplyr)
library(purrr)
library(flexdashboard)
library(sjPlot)
```

Column {data-width=650}
-----------------------------------------------------------------------

### Crosstabs

```{r}
# Converting several mtcars values to factors for sake of an easily reproducible example
mycars <- mtcars
mycars$cyl <- as.factor(mycars$cyl)
mycars$vs <- as.factor(mycars$vs)
mycars$am <- as.factor(mycars$am)
mycars$gear <- as.factor(mycars$gear)
mycars$carb <- as.factor(mycars$carb)

# THIS is the part I'm having trouble with
mycars %>%
  select_if(is.factor) %>%
  select(-cyl) %>%
  imap(\(x, cname) {
    xt <-tab_xtab(
      mycars$cyl,
      x,
      var.labels=c("Cylinders", cname),
      show.row.prc = TRUE,
      show.summary=TRUE,
      show.na=TRUE
    )
    xt$knitr
  })
```

And the output I get looks something like:

$vs
[1] "<table style=\"border-collapse:collapse; border:none;\">\n <tr>\n <th style=\"border-top:double; text-align:center; font-style:italic; font-weight:normal; border-bottom:1px solid;\" rowspan=\"2\">Cylinders</th>\n <th style=\"border-top:double; text-align:center; font-style:italic; font-weight:normal;\" colspan=\"3\">vs</th>\n <th style=\"border-top:double; text-align:center; font-style:italic; font-weight:normal; font-weight:bolder; font-style:italic; border-bottom:1px solid; \" rowspan=\"2\">Total</th>\n </tr>\n \n<tr>\n <td style=\"border-bottom:1px solid; text-align:center; padding:0.2cm;\">0</td>\n <td style=\"border-bottom:1px solid; text-align:center; padding:0.2cm;\">1</td>\n <td style=\"border-bottom:1px solid; text-align:center; padding:0.2cm;\">NA</td>\n </tr>\n \n<tr> \n<td style=\"padding:0.2cm;...

Notice that instead of just plain HTML, which is what I'm hoping for, it wraps the whole thing in double quotes and escapes all of the internal double quotes.

I've tried a number of permutations including:

  1. Just outputting the table without assigning it to a variable
  2. Using purrr::iwalk() and including a print(xt$knitr) inside the function
  3. And probably a variety of iterations on that

The package author wrote a blog post related to this, but I can't figure out how my version is different.

Here's a screenshot of the above example after knitting:

screenshot of output described above

System Environment

Upvotes: 1

Views: 89

Answers (1)

morphatic
morphatic

Reputation: 7975

I found a solution, although it was a little counterintuitive to me and I'm not sure it's the best one. I'd like to see a cleaner/better one. The solution was to pipe everything to htmltools::knit_print.html(). Here's what I ended up with:

---
title: "Multiple Crosstabs Example"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

```{r setup, include=FALSE}
library(dplyr)
library(purrr)
library(flexdashboard)
library(sjPlot)
```

Column {data-width=650}
-----------------------------------------------------------------------

### Crosstabs

```{r}
# Converting several mtcars values to factors for sake of an easily reproducible example
mycars <- mtcars
mycars$cyl <- as.factor(mycars$cyl)
mycars$vs <- as.factor(mycars$vs)
mycars$am <- as.factor(mycars$am)
mycars$gear <- as.factor(mycars$gear)
mycars$carb <- as.factor(mycars$carb)

# THIS is the part I'm having trouble with
mycars %>%
  select_if(is.factor) %>%
  select(-cyl) %>%
  imap(\(x, cname) {
    xt <- tab_xtab(
      mycars$cyl,
      x,
      var.labels=c("Cylinders", cname),
      show.row.prc = TRUE,
      show.summary=TRUE,
      show.na=TRUE
    )
    xt$knitr
  }) %>% htmltools::knit_print.html() # <- THIS IS WHAT I ADDED
```

Upvotes: 0

Related Questions