I wish to implement formatCurrency() and formatPercentage() (both from DT package) across multiple columns simultaneously in a shiny dashboard. I am using shinymaterial for the given example.
I am currently doing the following:
# The packages to load.
required_packages <- c("shiny", "shinymaterial", "DT", "tidyverse")
# This function will load in all the packages needed.
lapply(required_packages, require, character.only = TRUE)
# A table example.
ui <- material_page(
title = "Example table",
tags$h1("Table example"),
material_card(
title = "Table",
material_row(
DT::dataTableOutput("data_table_example")
),
depth = 1
)
)
server <- function(input, output) {
data_table_example_data = tibble(
Person = paste0("Person ", c(1:100)),
`Price $` = rnorm(100, 50000, 500),
`Cost $` = rnorm(100, 30000, 300),
`Probability %` = rnorm(100, 0.6, 0.1),
`Win %` = rnorm(100, 0.5, 0.2)
)
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency("Price $") %>%
formatCurrency("Cost $") %>%
formatPercentage("Probability %", digits = 1) %>%
formatPercentage("Win %", digits = 1)
})
}
shinyApp(ui = ui, server = server)
However, what I wish to do is, within the renderDataTable() function, to simplify the format functions into fewer lines. For example, implement formatCurrency() in any column with a "$" and formatPercentage() in any column with a "%".
I have done a fair bit of searching for an appropriate but could not find a solution, but I assume I am just missing a fairly simple solution.
Something like:
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency(grepl("$", colnames()) %>%
formatPercentage(grepl("%", colnames()), digits = 1)
})
A few additional points:
The tibble will actually be a reactive
This example is a very trivial version of a rather more complex table and set of reactives
I do not want to implement the formatting in the reactive part since I find this then messes with the DT sorting function, since it assumes the column is a character string
Any help will be greatly appreciated
Try:
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency(grepl("$", colnames(data_table_example_data)) %>%
formatPercentage(grepl("%", colnames(data_table_example_data)), digits = 1)
})
It seems you need to be explicit with the data so colnames() doesn't work - you need colnames(data_table_example_data).
I noticed during testing if you use grepl with rownames = TRUE that rownames becomes the first column name which means all the formatting is out by one. grep seems to not have this issue.
Related
The first column of the datatable consits of names, while the second column uses characters which are a combination of numeric with comma delimiters, and characters for other values, for example, "1,000" , "2,000", "19,000", "Data missing", "Data suppressed". Using type = "num-fmt" I am able to get the datatable to display correctly when I run it as a function by itself, i.e. "1,000", "2,000", "19,000", and when using sort in the Rstudio terminal its ordering is correct, and as such when first displayed in the R shiny app it works. However, when using the sort options in the shiny interface, the ordering no longer works correctly, i.e. "1,000" , "19,000" , "2,000".
My understanding is that I must do the sorting in the server, or use java script, but I don't know how.
ui <- dashboardPage(
box(title = "Industries from selected region",
status = "danger",
solidHeader = TRUE,
DT::dataTableOutput("industry_tbl"),
width = 6)
)
server <- function(input, output, session) {
values <- reactiveValues(direction = "Exports",
year = "2020",
partner_country = "Spain",
industry = "Mining",
home_country = "UK")
output$industry_tbl<- DT::renderDT({
industry_table_server(new_data,
values$year,
values$partner_country,
values$direction,
values$home_country)
})
function:
industry_table_server <- function(dataset,
selected_year,
selected_country,
selected_direction,
selected_region){
this_selection <- dplyr::filter(dataset,
Year == selected_year,
Country == selected_country,
Direction == selected_direction,
`Area name` == selected_region) %>%
select(Industry, value)
DT::datatable(this_selection ,
colnames = c("Industry",
paste0("£millions")),
filter = "none",
rownames = TRUE,
extensions = c('Buttons'),
options = list(
dom = 'Bftip',
buttons = c('copy', 'excel', 'print'),
searchHighlight = TRUE,
searchDelay = 0,
selection = "single",
pageLength = 10, # Shows 10 results
lengthMenu = c(5, 10),
columnDefs = list(list(className = 'dt-right', targets = c(0,2)), list(targets = c(2), type = "num-fmt"))
)
)
} ```
As said in the datatables website, regarding the type option:
Please note that if you are using server-side processing this option has no effect since the ordering and search actions are performed by a server-side script.
So you have to set server = FALSE in renderDT:
output$industry_tbl <- renderDT({
industry_table_server(new_data,
values$year,
values$partner_country,
values$direction,
values$home_country)
}, server = FALSE)
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/
I am trying to only show two decimal places for all data in my table and align everything centrally. The first column is countries, but the rest are numbers. This is the code
output$Composite <- renderDataTable(FVI_DATA_COMPOSITE, options = list(pageLength = 15,lengthChange=FALSE))
Any idea how to do that?
Edit: This does not work.
output$Composite <- renderDataTable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE), round(FVI_DATA_COMPOSITE[3:9], digits=2)
output$Composite <- renderDataTable(datatable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE)) %>% formatRound(c(3:9), 2)
Documentation here
Edit: To center align
output$Composite <- renderDataTable(datatable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE)) %>%
formatRound(c(3:9), 2) %>%
formatStyle(columns = c(3:9), 'text-align' = 'center')
The accepted answer's code pattern kept returning the following warning/error:
Warning: Error in : object of type 'closure' is not subsettable
I had to use a slightly different pattern within a Shiny app.R file:
server <- function(input, output) {
output$dtable <- DT::renderDataTable({
datatable(FVI_DATA_COMPOSITE) %>%
formatRound(columns = c(3:9), digits = 2)
})
}
I'm creating my first shiny app, everything works fantastic when using ggplot2 but using other base R or vcd plots has me stuck. I'd like the user to be able to select a tabling variable and then view a resulting mosaic or association plot. My server code fails at the table command. Things I've already tried are commented out below.
Thanks for the help.
library(shiny)
library(shinydashboard)
library(vcd)
header = dashboardHeader(title = 'Min Reproducible Example')
sidebar = dashboardSidebar()
body = dashboardBody(
fluidRow(plotOutput('plot'), width=12),
fluidRow(box(selectInput('factor', 'Select Factor:', c('OS', 'Gender'))))
)
ui = dashboardPage(header, sidebar, body)
server = function(input, output){
set.seed(1)
df = data.frame(Condition = rep(c('A','B','C','D'), each = 300),
Conversion = c(sample(c('Convert','Not-Convert'), 300, replace = TRUE, prob = c(0.9, 0.1)),
sample(c('Convert','Not-Convert'), 300, replace = TRUE, prob = c(0.7, 0.3)),
sample(c('Convert','Not-Convert'), 300, replace = TRUE, prob = c(0.5, 0.5)),
sample(c('Convert','Not-Convert'), 300, replace = TRUE, prob = c(0.2, 0.8))),
Gender = sample(c('M','F'), 1200, replace = TRUE),
OS = rep(sample(c('Web','iOS','Android'), 1200, replace = TRUE), times = 2))
#tried this
#table1 = reactive({
# with(df, table(Condition, Conversion, input$factor))
#})
output$plot = renderPlot({
#fails here:
table1 = with(df, table(Condition, Conversion, input$factor))
#also tried these
#table1 = with(df, table(Condition, Conversion, as.character(isolate(reactiveValuesToList(input$factor)))))
#also tried table1 = with(df, table(Condition, Conversion, input$factor))
#also tried table1 = table(df$Condition, df$Conversion, paste0('df$', input$factor))
#then I want some categorical plots
assoc(table1, shade=TRUE)
#or mosaicplot(table1, shade=TRUE)
})
}
shinyApp(ui, server)
An easy fix would be to use 'starts_with' from dplyr in a select() statement on your input variable
library('dplyr')
output$plot = renderPlot({
df <- select(df, Condition, Conversion, tmp_var = starts_with(input$factor))
table1 = with(df, table(Condition, Conversion, tmp_var))
mosaicplot(table1, shade=TRUE)
})
}
There seems to be some others who are confused by this same issue but after reading and attempting the solutions I found here, I am still stumped. Help!
I have a Shiny App that takes the difference between prices between two dates and returns a list of 4 tables one for each type of Product for each Date, and the same 4 tables for the Price Deltas of the two Dates.
(DATE1, DATE2, DELTA)
On my output screens after Calc, the tables remain empty until the user clicks on the inputSelectors which prompt the table to refresh.
I am still struggling to understand how to get the table to automatically refresh when the Calculation ends.
Here is the logic in my Server.R file concerning the output of one of dataTables:
dataset_HL <- reactive({
switch(input$dataset_HL,
"Deltas" = DELTA$HL,
"Date 1" = DATE1$HL,
"Date 2" = DATE2$HL)
})
termGroup_HL <- reactive({
switch(input$termGroup_HL,
"ALL" = rowIndex$ALL,
"BOM" = rowIndex$BOM,
"QTR" = rowIndex$QTR,
"CAL" = rowIndex$CAL)
})
values_HL <- reactive({
data <- dataset_HL()
colnames(data) <- locations$HL
data <- cbind(Terms = rownames(data), data)
rows <- termGroup_HL()
return(data[rows, ])
})
output$table_HL <- renderDataTable({
datatable(values_HL(),
rownames = FALSE,
options = list(
pageLength = 25,
lengthMenu = c(10, 25, 50, 100)
))
})
Thank you ahead of time.
I found my answer finally and of course it was already answered by Joe Cheng here, Shiny Reactivity.
Simply adding a call to my action button, input$GET_Dates, inside my reactive function triggered the re-calc of the table.
I also simplified my reactive values function.
values_HL <- reactive({
input$GET_Dates
dataset <- switch(input$dataset_HL,
"Deltas" = DELTA$HL,
"Date 1" = DATE1$HL,
"Date 2" = DATE2$HL)
termGroup <- switch(input$termGroup_HL,
"ALL" = rowIndex$ALL,
"BOM" = rowIndex$BOM,
"QTR" = rowIndex$QTR,
"CAL" = rowIndex$CAL)
data <- dataset[termGroup, ]
data <- cbind(Terms = rownames(data), data)
data
})
output$table_HL <- renderDataTable({
datatable(values_HL(),
rownames = FALSE,
options = list(
pageLength = 25,
lengthMenu = c(10, 25, 50, 100)
))
})