Rendering a Kable table with images in Shiny - r

I created an R Markdown HTML report where I am using Kable tables. I am trying to convert this report into a Shiny dashboard, and I noticed that the Kable table from the report does not display the images in Shiny.
This is how the table displays in Rmd:
This is how the table displays in Shiny:
This is the code that produces the tables: The images are picked (status_image and significance_image) change depending their pct_change and significant_greater_less_pvalue values.
dt_2 <- cbind(initial_medians_table(), medians_significance_df) %>%
mutate(notes = "",
status_image = paste("![](www/", ifelse(pct_change <= 0, "down_arrow_green", "up_arrow_red"), ".png)", sep = ""),
significance_image = paste("![](www/", ifelse(significant_greater_less_pvalue < input$pvalue_threshold, "significant", "not_significant"), ".png)", sep = ""),
medians_analysis = paste(medians_analysis, " mins (", round(medians_analysis/(24*60), 2), " days)", sep = ""),
medians_baseline = paste(medians_baseline, " mins (", round(medians_baseline/(24*60), 2), "days)", sep = "")) %>%
select(V1, V2, medians_analysis, medians_baseline, change, status_image, significance_image, notes)
And this is how I am rendering in Shiny:
ui.R
uiOutput("tableset")
server.R
output$tableset <- renderUI({
out <- kable(medians_and_significant_test(), align = rep('c', ncol(medians_and_significant_test())), escape = FALSE,
col.names = c("High-Level Process",
"Deeper-Level Process",
"Analysis (Median)",
"Baseline (Median)",
"% Change",
"Performance",
"Statistically Significant?",
"Notes")) %>%
kable_styling(c("striped", "condensed", "hover", "responsive"), full_width = F) %>%
kableExtra::group_rows(index = c("Level 0" = 1, "Level 1" = 3, "Level 2" = 6)) %>%
footnote(symbol = c(paste("Significance test used:", input$sig_test_selected),
paste("p-value threshold used is", input$pvalue_threshold, "to test for significant"))
)
HTML(out)
})
I am using the wrong "string" or call for rendering the images in a cell? I am also happy to use DT if anyone knows how to render images from the www app folder on the cell.
Thanks in advance

Related

Is there a package to create an rmarkdown table with separate sections with headers mid-table? (preferred pdf output)

I'm creating a document with rmarkdown, ultimately for pdf output.
I'd like to make a table that has multiple sections with subheadings (title, abstract, introduction etc.) such as the table below
I've made the following so far, but I'd like to have the vertical lines present apart from the heading rows("Title", "Abstract" etc):
{r prch}
pc = structure(list(`Section/topic` = c("\\textbf{Title}", "Title",
"\\textbf{Abstract}", "Structured summary"), `Item No` = c("",
"1", "", "2"), `Checklist item` = c("", "Identify the report as a systematic review, meta-analysis, or both",
"", "Provide a structured summary including, as applicable, background, objectives, data sources, study eligibility criteria, participants, interventions, "
), `Reported on page No` = c("", "", "", "")), row.names = c(NA,
-4L), class = c("tbl_df", "tbl", "data.frame"))
pc%>%
kbl(longtable = T, escape = F, booktabs = T)%>%
column_spec(1, width = "8em")%>%
column_spec(3, width = "20em")%>%
column_spec(4, width = "6em")%>%
kable_styling(latex_options = c("repeat"))
Here's a huxtable-based solution. (My package.)
library(huxtable)
ht <- tribble_hux(
~ "Section/topic", ~ "Item no", ~ "Checklist item", ~ "Reported on Page No",
"Title" , "" , "" , "",
"Title" , "1" , "Identify..." , "",
"Abstract" , "" , "" , "",
"Structured summary", "2" , "Provide..." , ""
# et cetera...
)
# using the pipe from 4.1.0...
ht |>
set_header_rows(c(2, 4), TRUE) |>
merge_across(c(2, 4), everywhere) |>
style_header_rows(bold = TRUE) |>
set_all_borders(brdr(0.4, "solid", "grey70")) |>
set_background_color("grey97") |>
set_background_color(1, 1:3, "grey90") |>
set_col_width(c(0.2, 0.05, 0.55, 0.2)) |>
set_font("cmss") |>
quick_pdf()

Export table to pretty XLS/open document spreadsheet

What is the best way to export a table similar to this (retaining the formatting on the footnotes, bolding of titles etc) from R to an Excel XLS/open document format?
Is it possible with to neatly convert the HTML output in RMarkdown or export directly to Excel?
library(knitr)
library(kableExtra)
dt <- mtcars[1:5, 1:6]
kable(dt, align = "c") %>%
kable_styling(full_width = F) %>%
footnote(general = "Here is a general comments of the table. ",
number = c("Footnote 1; ", "Footnote 2; "),
alphabet = c("Footnote A; ", "Footnote B; "),
symbol = c("Footnote Symbol 1; ", "Footnote Symbol 2"),
general_title = "General: ", number_title = "Type I: ",
alphabet_title = "Type II: ", symbol_title = "Type III: ",
footnote_as_chunk = T, title_format = c("italic", "underline")
)
The output file will need to have multiple worksheets, e.g. the above + another for a title, and be white background filled.
basictabler / Rmarkdown hybrid might be an idea?
Thanks.

Indentation when line break in group_rows() command - kableExtra package in R markdown

I'm using the kableExtra package to output a table to PDF in R markdown.
I use the command group_rows() to group some rows of my table together.
The text in some rows of my first column is too long for the column width, so it is broken into two lines. However, there is no indentation of the second line. Is there a way to either indent also the second line or remove the indentation overall?
Increasing the column width so the text won't be spread over two lines is unfortunately no option since I have way more columns in my real table.
This is a subset of my data frame:
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita",
"Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
This is the code I am using:
```{r}
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean")) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
This is how the .pdf output looks like. As you can see, e.g. the text "top income tax rate" is split into two lines and I would like the second line to be indented just like the first line.
Thank you for any tips!
If you just run the chunk in the R console, you'll see this LaTeX output:
\begin{table}[H]
\caption{\label{tab:}table 1}
\centering
\resizebox{\linewidth}{!}{
\begin{tabular}[t]{>{\raggedright\arraybackslash}p{3cm}lll}
\toprule
\multicolumn{1}{c}{} & \multicolumn{1}{c}{} & \multicolumn{2}{c}{Top 10\%} \\
\cmidrule(l{2pt}r{2pt}){3-4}
Control variables & Treated & Synthetic & Mean\\
\midrule
\addlinespace[0.3em]
\multicolumn{4}{l}{\textbf{UK}}\\
\hspace{1em}GDP growth & 2.29 & 3.37 & 2.95\\
\hspace{1em}GDP per capita & 21,523.57 & 19,939.72 & 30,242.60\\
\addlinespace[0.8cm]
\multicolumn{4}{l}{\textbf{Japan}}\\
\hspace{1em}Top income tax rate & 0.70 & 0.68 & 0.64\\
\hspace{1em}Right-wing executive & 0.62 & 0.63 & 0.43\\
\bottomrule
\multicolumn{4}{l}{\textit{Note: }}\\
\multicolumn{4}{l}{xxx}\\
\end{tabular}}
\end{table}
As you can see, kableExtra isn't putting in a line break in that title, LaTeX is doing it. This means you need a LaTeX fix for the problem. Maybe someone else knows an easier one, but the best I could find is the following: wrap the long row title in a minipage environment, and fiddle with the spacing to look better.
Since this is kind of messy, I'd write an R function to do it:
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\vspace{1.2ex}\\end{minipage}")
This needs to be called on the data being put into the table, and kable needs to be told not to escape those backslashes (using escape = FALSE). In addition, the \setstretch command comes from the setspace LaTeX package. So overall your sample document would look like this:
---
output:
pdf_document:
extra_dependencies: setspace
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(kableExtra)
library(knitr)
```
```{r}
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\end{minipage}")
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita", "Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
data[[1]] <- inMinipage(data[[1]], "2.5cm")
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean"), escape = FALSE) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
With that code I see this:
The spacing isn't quite right, but it's getting close. I hope this helps.

Controlling row height in kableExtra()

Hi i made this awesome table with kableExtra, but my only problem is that the height of the rows is not always equal. Does any one know a remedy for this?
my table:
for example, as you can see, the line for item number 22 (6th row) has a larger height (spacing) than other lines.
my code:
my_column_names = c("Item number", "Item",
"Emotion", "Social",
"At Home", "Body", "Emotion",
"Social 1", "Social 2",
"At Home", "Body")
kable(df1,
format = "latex", booktabs = TRUE,
col.names = my_column_names,
caption = "Factor loadings for the 4 and 5 Factor Model") %>%
kable_styling(latex_options = c("striped", "hold_position"),
full_width = FALSE) %>%
add_header_above(c(" " = 2,
"4 Factor Model " = 4, "5 Factor model" = 5)) %>%
add_header_above(c(" " = 2,
"Model" = 9)) %>%
kableExtra::landscape()
The reason why the row height is not always equal is that by default kable inserts a \addlinespace every 5th rows. To get rid of it, put linesep = "" in kable(). See Get rid of \addlinespace in kable for details.
Usually, this is something that you can change via CSS in an HTML table. Not sure how to do this with kableExtra but you might want to consider tableHTML to do it. I am adding a small example below to demonstrate row height:
library(tableHTML)
tableHTML(mtcars[1:10, ],
border = 1,
rownames = TRUE,
caption = 'This is a caption',
footer = 'This is a footer',
widths = c(140, rep(50, 11)),
second_headers = list(c(2, 5, 6), c('', 'col2', 'col3')),
theme = 'scientific') %>%
add_css_row(list('height', '50px'), rows = 3:12)
You don't need to use the scientific theme if you don't want to. The package gives you flexibility to add any css you like (like striped rows, etc.). You can check a tutorial here if interested.
P.S. It currently only supports one extra header. Apart from that your whole table can be replicated.

How to Format R Shiny DataTable Like Microsoft Excel Table

I have some tables in Microsoft Excel that I need to recreate in an R Shiny App. The formatting in R has to remain at least mostly the same as the original context.
Here are images of the original tables:
Table 1
Table 2
Notice the formatting: There are lines under table headers and above totals, headers and totals are bolded, numbers in the Monthly Bill column have thousands seperated by commas and have dollar symbols, and the final number in Table 2 is boxed in.
If the lines were not recreatable it would be fine, but I need to at least be able to bold the selected topics, headers, and totals, and be able to get the correct number format for the Monthly Bill column.
I have tried using the DT package but I can't figure out how to format rows instead of columns. I noticed DT uses wrappers for JavaScript functions but I don't personally know JavaScript myself. Is there a way to format this the way I that I need through R packages or Javascript?
Edit:
Although it would be simple, I cannot merely include an image of the tables because some of the numbers are going to be linked to user input and must have the ability to update.
pixiedust makes it easy to do cell-specific customizations.
T1 <- data.frame(Charge = c("Environmental", "Base Power Cost",
"Base Adjustment Cost", "Distribution Adder",
"Retail Rate Without Fuel", "Fuel Charge Adjustment",
"Retail Rate With Fuel"),
Summer = c(0.00303, 0.06018, 0.00492, 0.00501, 0.07314,
0.02252, 0.09566),
Winter = c(0.00303, 0.05707, 0.00468, 0.01264, 0.07742,
0.02252, 0.09994),
Transition = c(0.00303, 0.05585, 0.00459, 0.01264,
0.07611, 0.02252, 0.09863),
stringsAsFactors = FALSE)
T2 <- data.frame(Period = c("Summer", "Winter", "Transition", "Yearly Bill"),
Rate = c(0.09566, 0.09994, 0.09863, NA),
Monthly = c(118.16, 122.44, 121.13, 1446.92),
stringsAsFactors = FALSE)
library(shiny)
library(pixiedust)
library(dplyr)
options(pixiedust_print_method = "html")
shinyApp(
ui =
fluidPage(
uiOutput("table1"),
uiOutput("table2")
),
server =
shinyServer(function(input, output, session){
output$table1 <-
renderUI({
dust(T1) %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = c(5, 7),
cols = 2:4,
border = "top") %>%
sprinkle(rows = c(5, 7),
bold = TRUE) %>%
sprinkle(pad = 4) %>%
sprinkle_colnames(Charge = "") %>%
print(asis = FALSE) %>%
HTML()
})
output$table2 <-
renderUI({
T2 %>%
mutate(Monthly = paste0("$", trimws(format(Monthly, big.mark = ",")))) %>%
dust() %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = 4,
cols = 1,
bold = TRUE) %>%
sprinkle(rows = 4,
cols = 3,
border = "all") %>%
sprinkle(na_string = "",
pad = 4) %>%
sprinkle_colnames(Period = "",
Monthly = "Monthly Bill") %>%
print(asis = FALSE) %>%
HTML()
})
})
)
This would be easier if you provided an example of your data, but sticking with DT, you should be able to utilize formatStyle to change formatting of both rows and columns. For an example to bold the first row, see the following (assuming your data frame is called df):
df %>%
datatable() %>%
formatStyle(
0,
target = "row",
fontWeight = styleEqual(1, "bold")
)
The rstudio DT page offers more examples: http://rstudio.github.io/DT/010-style.html
Alternatively, I think you might be better off using the stargazer package.
The base plot would look very similar to your desired result.
stargazer::stargazer(df, type = "html", title = "Table 1")
That will get you started, but see here for a LOT more flexibility: https://www.jakeruss.com/cheatsheets/stargazer/

Resources