I am working on a shinyapp whose goal is to allow the user to select different options and at the end get the sum of the numerical column whose options he chose match with. By options I mean there’s two dropdown menus, first one being the brand name, the second one being the county. So, after choosing these options, sum of the profit column should show at the bottom of the table. The code I tried to use to get the sum was from this answer.
When I run the app, it says 'processing'. Any help is greatly appreciated.
Here’s some data I put together
library(shiny)
library(stringr)
library(DT)
library(shinydashboard)
library(scales)
library(dplyr)
library("shinycustomloader")
data <- structure(
list(
Date = c(
"2016-01", "2016-02", "2016-03", "2016-04", "2016-05", "2016-06",
"2016-07", "2016-08", "2016-09", "2016-10", "2016-11", "2016-12",
"2017-01", "2017-02", "2017-03", "2017-04", "2017-05", "2017-06",
"2017-07", "2017-08", "2017-09", "2017-10", "2017-11", "2017-12",
"2018-01", "2018-02", "2018-03", "2018-04", "2018-05", "2018-06",
"2018-07", "2018-08", "2018-09", "2018-10", "2018-11", "2018-12"
),
County = c(
"county1", "county3", "county2", 'county2', 'county7', 'county9',
"county4", "county9", "county1", "county2", "county2", "county8",
"county2", "county5", "county6", "county5", "county7", "county9",
"county5", "county3", "county6", "county4", "county5", 'county1',
'county2', 'county7', 'county9', 'county5', 'county4', 'county1',
'county3', 'county5', 'county2', 'county9', 'county6', 'county3'),
`Brand Name` = c(
"Oreo", "Lindt", "Snickers", "OMO", "Oreo", "Lindt",
"Snickers", "OMO", "Oreo", "Lindt", "Lindt", "Snickers",
"Oreo", "Lindt", "Snickers", "OMO", "Oreo", "Lindt",
"Snickers", "OMO", "Oreo", "Lindt", "Lindt", "Snickers",
"OMO", "Oreo", "Lindt", "Snickers", "OMO", "Oreo",
"Lindt", "Snickers", "OMO", "OMO", "Oreo", "Lindt"
),
Profit = c(
3542.07, 6024.91, 4739.9, 2344.03, 3294.06, 7478.54, 4482.91,
2760.74, 4195.26, 6424.08, 7100.65, 5712.05, 3542.07, 6024.91,
4739.9, 2344.03, 3294.06, 7478.54, 4482.91, 2760.74, 4195.26,
6424.08, 7100.65, 5712.05, 2746.28, 5892.93, 9774.93, 6659.96,
3121.69, 4753.31, 9652.76, 5990.85, 2838.11, 3354.48, 4495.58,
10483.94
)
),
class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -36L),
spec = structure(
list(
cols = list(
Date = structure(
list(), class = c("collector_character", "collector")
),
`Brand Name` = structure(
list(), class = c("collector_character", "collector")
),
Profit = structure(
list(), class = c("collector_double", "collector")
)
),
default = structure(
list(), class = c("collector_guess", "collector")
),
skip = 1
),
class = "col_spec"
)
)
Here's what I tried
data<-as.data.frame(data)
jsCode <- "function(row, data, start, end, display) {var api = this.api(), data;$( api.column(3).footer() ).html('Total: ' + MYTOTAL);}"
# Workaround
getTotal <- function(data,index){
if(index < 1 || index > ncol(data)){
return("")
}
col <- data[,index]
col <- gsub("[$]","",col)
col <- gsub("[,]","",col)
col <- suppressWarnings(as.numeric(col))
if(all(is.na(col))){
return("")
}
sum(col)
}
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width)) {
paste0("width: ", validateCssUnit(width), ";")
},
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status, " dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});"
)
)
}
# app ---------------------------------------------------------------------
ui <- fluidPage(
tags$h1("Example dropdown button"),
br(),
sidebarPanel(
sliderInput("yearrange", "Select Years",
min = 2016, max = 2018,
value = c(min, max)
),
sliderInput("monthrange", "Select Months",
min = 1, max = 12,
value = c(min, max)
),
dropdownButton(
label = "Choose Brand", status = "default", width = 80,
actionButton(inputId = "a2z", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
actionButton(inputId = "z2a", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
br(),
actionButton(inputId = "all", label = "(Un)select all"),
checkboxGroupInput(inputId = "check2", label = "Choose", choices = unique(data$`Brand Name`))
),
dropdownButton(
label = "Choose County(ies)", status = "default", width = 80,
actionButton(inputId = "a2z_1", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
actionButton(inputId = "z2a_1", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
br(),
actionButton(inputId = "all_1", label = "(Un)select all"),
checkboxGroupInput(inputId = "check3", label = "Choose", choices = unique(data$County))
)
),
mainPanel(
DT::dataTableOutput("table")
)
)
server <- function(input, output, session) {
# Select all / Unselect all for Brand Names
observeEvent(input$all, {
if (is.null(input$check2)) {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = unique(data$`Brand Name`)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = ""
)
}
})
# Select all / Unselect all for counties
observeEvent(input$all_1, {
if (is.null(input$check3)) {
updateCheckboxGroupInput(
session = session, inputId = "check3", selected = unique(data$County)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check3", selected = ""
)
}
})
# Sorting asc for brand name
observeEvent(input$a2z, {
updateCheckboxGroupInput(
session = session, inputId = "check2", choices = sort(unique(data$`Brand Name`)), selected = input$check2
)
})
# Sorting desc for brand name
observeEvent(input$z2a, {
updateCheckboxGroupInput(
session = session, inputId = "check2", choices = sort(unique(data$`Brand Name`), decreasing = T), selected = input$check2
)
})
# Sorting asc for counties
observeEvent(input$a2z_1, {
updateCheckboxGroupInput(
session = session, inputId = "check3", choices = sort(unique(data$County)), selected = input$check3
)
})
# Sorting desc for counties
observeEvent(input$z2a_1, {
updateCheckboxGroupInput(
session = session, inputId = "check3", choices = sort(unique(data$County), decreasing = T), selected = input$check3
)
})
Total <- reactive({
getTotal(data,2)
})
cont <- htmltools::withTags(table(
tableHeader(names(data)),tableFooter(names(data))
))
output$table <- DT::renderDataTable({
#browser()
jsCode <- sub("MYTOTAL",Total(),jsCode)
selectedBrand <- input$check2 # gets selected brands
selectedCounty <- input$check3 # gets selected counties
data <- data[which(data$`Brand Name` %in% selectedBrand), ] # returns data matching selected brand
county_choice <- data[which(data$County %in% selectedCounty), ] # returns data matching selected counties
year_table <- county_choice[county_choice$Date >= input$yearrange[1] & county_choice$Date <= input$yearrange[2] + 1, ]
year_table[unlist(stringr::str_split(year_table$Date, "-"))[c(F, T)] >= sprintf("%02d", input$monthrange[1]) & unlist(stringr::str_split(year_table$Date, "-"))[c(F, T)] <= sprintf("%02d", input$monthrange[2]), ]
}, container = cont, rownames = F,
options = list(
autoWidth = T,
pageLength = 10,
scrollCollapse = T,
footerCallback = JS(jsCode))
)
}
shinyApp(ui = ui, server = server)