I'm working on a shiny dashboard that will display datasets that often contain some suppressed values (typically represented as characters like "!!") in columns that are mostly numeric. I've got various user inputs on the dashboard that can filter and chop up the data in different ways, and one of them replaces these suppressed values with unique numeric values (like -99999) (with a switch called numeric_suppression_switch). I do this a way of making the columns numeric so that we can do calculations with the data in the dashboard, whilst also keeping the context of the different suppression types, so that these are not lost by transforming to just NAs.
The dashboard also has a download button for downloading snapshots of the datasets once we've used the various inputs. What I'm looking to see, is if there's a way to include a safety net in my button for downloading my file, that will recode any suppressed values back to their original character formats before the output file is saved.
I've tried using an observeEvent() to pick up inputs with the download button, as a way to update/turn off my numeric_suppression_switch but that doesn't seem to work.
I've also tried nesting this within the downloadHandler() function, and while it does seem to update the status of the switch, it seems to save the file first, and then flip the numeric_suppression_switch back to off - which is certainly close, but just too late.
The other way I've tried to look at this, is to apply the inverted versions of the str_replace_all() to recode the suppressed values back to their original state, but this also doesn't seem to work due to the data being a reactive object. I tried also saving the file and then reloading it, recoding it, and then saving it again - which also didn't work.
Any advice or guidance would be greatly appreciated.
Example below:
library(shiny)
library(tidyverse)
library(shinyWidgets)
library(DT)
# introduce some suppressed values to dataset for an example: ----
test_data <- cars %>%
mutate_at("speed", ~str_replace_all(., pattern = "10", replacement = "!!"))
# Define UI for application ----
ui <- fluidPage(
# Application title ----
titlePanel("Dashboard"),
# Sidebar with user inputs ----
sidebarLayout(
sidebarPanel(
tags$hr(),
# Switch for transforming suppressed values to numeric ----
switchInput(inputId = "numeric_suppressed", label = "Numeric Suppressed", value = FALSE),
tags$hr(),
# Button for downloading the data in the table ----
downloadButton('download',"Download dataset"),
tags$hr(),
),
# Show dataset as table ----
mainPanel(
tabsetPanel(
tabPanel("Table", column(6, DT::dataTableOutput(outputId = 'main_table')))
)
)
)
)
# Define server logic ----
server <- function(input, output, session) {
# Make reactive version of dataset that responds to inputs from UI ----
df <- reactive({
temp_reactive <- test_data
# Where the numeric_suppression switch is active, replace suppressed values with numbers ----
if (input$numeric_suppressed == TRUE){
temp_reactive <- temp_reactive %>%
mutate_at("speed",
~str_replace_all(., replacement = "-99999", pattern = "!!"))
}
temp_reactive
})
# Show data as a datatable for UI ----
output$main_table <- DT::renderDataTable({df()}, rownames = FALSE)
### --- This feels like it should work but doesn't... ----
observeEvent(input$download,
label = "suppression_catch", {
updateSwitchInput(session = session,
inputId = "numeric_suppressed",
value = FALSE)
})
### --- This could be an alternative that just recodes the data on its way out ---
### --- But it doesn't seem to like this because its a reactive object
# df <- df %>%
# mutate_at("speed", ~str_replace_all(., replacement = "10", pattern = "!!"))
# Output data from datatable as .csv file ----
output$download <- downloadHandler(
## --- Needs to recode -99999 as "!!" before the file is generated/saved ---``
filename = function(){paste0(Sys.Date(), "Snapshot", ".csv")},
content = function(data_file_name){
write.csv(x = df(),file = data_file_name, row.names = FALSE)
### --- I've also tried reloading the data back in as part of the saving process,
### --- recoding it and saving it again, but this also didn't work
# temp <- tibble(read_csv(data_file_name)) %>%
# mutate_at("speed", ~str_replace_all(., replacement = "10", pattern = "!!"))
# write.csv(x = temp, file = data_file_name, row.names = FALSE)
}
)
}
# Run the application ----
shinyApp(ui = ui, server = server)
CodePudding user response：
Since the data is large, I infer that you don't want two copies of it hanging around. In that case, consider adding columns to it that allow you to have both the -99999 and the !! versions of all of those variables. Inferring (again) that your mutate_all (superseded) is on more than one column, try using mutate(across(.., .names="...")) to rename them as you go. For instance,
tibble(mtcars) %>%
mutate(across(c(cyl,disp), as.character, .names = "{.col}_new"))
# # A tibble: 32 x 13
# mpg cyl disp hp drat wt qsec vs am gear carb cyl_new disp_new
# <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
# 1 21 6 160 110 3.9 2.62 16.5 0 1 4 4 6 160
# 2 21 6 160 110 3.9 2.88 17.0 0 1 4 4 6 160
# 3 22.8 4 108 93 3.85 2.32 18.6 1 1 4 1 4 108
# 4 21.4 6 258 110 3.08 3.22 19.4 1 0 3 1 6 258
# 5 18.7 8 360 175 3.15 3.44 17.0 0 0 3 2 8 360
# 6 18.1 6 225 105 2.76 3.46 20.2 1 0 3 1 6 225
# 7 14.3 8 360 245 3.21 3.57 15.8 0 0 3 4 8 360
# 8 24.4 4 147. 62 3.69 3.19 20 1 0 4 2 4 146.7
# 9 22.8 4 141. 95 3.92 3.15 22.9 1 0 4 2 4 140.8
# 10 19.2 6 168. 123 3.92 3.44 18.3 1 0 4 4 6 167.6
# # ... with 22 more rows
This would mean that any other methods you have for depicting the data in your shiny app (whether it be plotting or tables) would need to remove the not-converted columns, and the download method would need to remove the _new columns.
Examples:
output$someplot <- renderPlot({
df() %>%
select(-cyl, -disp) %>%
ggplot(...) geom_point()
})
output$download <- downloadHandler(
filename = function() paste0(Sys.Date(), "Snapshot.csv"),
content = function(filename) {
df() %>%
select(-ends_with("_new")) %>%
write.csv(file = filename, row.names = FALSE)
})
(dplyr used for convenience here since you have it loaded; it is not required, the use of subset for base should work just as well.)