Save results from dynamically filtered data to a csv file

Question

I'm trying to save the result of dynamically filtered data into a csv file ; I created a button etc but the app freezes up when i press it... any help would be much appreciated i'm new to Shiny unfortunately

library(dplyr)
library(shinyWidgets)

fpath <- '/dbfs/May2022'

# Define UI
ui <- fluidPage(theme = shinytheme("spacelab"),
                navbarPage(
                  "Display Data",
                  tabPanel(
                    "Select File",
                    sidebarPanel(
                      selectInput('selectfile','Select File',choice = list.files(fpath, pattern = ".csv")),
                      mainPanel("Main Panel",dataTableOutput("ftxtout"),style = "font-size:50%") # mainPanel
                    ), #sidebarPanel
                  ), #tabPanel
                  tabPanel("Subset Data",
                           sidebarPanel(
                             dropdown(
                               label = "Please Select Columns to Display",
                               icon = icon("sliders"),
                               status = "primary",
                               pickerInput(
                                 inputId = "columns",
                                 #       label = "Select Columns",
                                 choices = NULL,
                                 multiple = TRUE
                               )#pickerInput
                             ), #dropdown
                             selectInput("v_attribute1", "First Attribute to Filter Data", choices = NULL),
                             selectInput("v_attribute2", "Second Attribute to Filter Data", choices = NULL),
                             selectInput("v_filter1", "First Filter", choices = NULL),
                             selectInput("v_filter2", "Second Filter", choices = NULL),
                             textInput("save_file", "Save to file:", value=""),
                             actionButton("doSave", "Save Selected Data")

                           ), #sidebarPanel

                           mainPanel(tags$br(),tags$br(),
                                     h4("Data Selection"),
                                     dataTableOutput("txtout"),style = "font-size:70%"
                           ) # mainPanel

                  ), # Navbar 1, tabPanel
                  tabPanel("Create Label", "This panel is intentionally left blank")

                ) # navbarPage
) # fluidPage


# Define server function
server <- function(input, output, session) {
  
  output$fileselected<-renderText({
    paste0('You have selected: ', input$selectfile)
  })

  info <- eventReactive(input$selectfile, {
    fullpath <- file.path(fpath,input$selectfile)
    read.csv(fullpath, header = TRUE,  sep = ",")
  })

  observeEvent(info(), {
    df <- info()
    vars <- names(df)
    # Update select input immediately after clicking on the action button.
    updatePickerInput(session, "columns","Select Columns", choices = vars, selected=vars[1:2])
  })
  
  observeEvent(input$columns, {
    vars <- input$columns
    updateSelectInput(session, "v_attribute1","First Attribute to Filter Data", choices = vars)
    updateSelectInput(session, "v_attribute2","Second Attribute to Filter Data", choices = vars, selected=vars[2]) 
  })

  observeEvent(input$v_attribute1, {
    choicesvar1=unique(info()[[input$v_attribute1]])
    req(choicesvar1)
    updateSelectInput(session, "v_filter1","First Filter", choices = choicesvar1)
  })

  observeEvent(input$v_attribute2, {
    choicesvar2=unique(info()[[input$v_attribute2]])
    req(choicesvar2)
    updateSelectInput(session, "v_filter2","Second Filter", choices = choicesvar2)
  })

  output$ftxtout <- renderDataTable({
    head(info())
  }, options =list(pageLength = 5))

  output$txtout <- renderDataTable({
    f <- info() %>% subset(select = input$columns) 
    f$var1 <- f[[input$v_attribute1]]
    f$var2 <- f[[input$v_attribute2]]
    ff <- f %>% dplyr::filter(var1 == input$v_filter1 & var2 == input$v_filter2) 
    fff <- ff %>% subset(select=-c(var1,var2))
    head(fff)
  }, options =list(pageLength = 5)                 
  ) #renderDataTable
  
       
  #Saving data
  observeEvent(input$doSave, {
    req(input$columns,input$v_attribute1,input$v_attribute2,input$v_filter1,input$v_filter2)
    f <- info() %>% subset(select = input$columns) 
    f$var1 <- f[[input$v_attribute1]]
    f$var2 <- f[[input$v_attribute2]]
    ff <- f %>% dplyr::filter(var1 == input$v_filter1 & var2 == input$v_filter2) 
    fff <- ff %>% subset(select=-c(var1,var2))
    fullfpath <- paste0(file.path(fpath,input$save_file),".csv",sep="")
    write.csv(fff,fullfpath, row.names = True)
    Save_done <- showNotification(paste("Data Has been saved"), duration = NULL)
  })

} # server

# Create Shiny object
shinyApp(ui = ui, server = server)

I've tried a few different things but can't get it work, i'm not sure what i'm doing wrong here!

user_11168766 · Answer

You have a typo when calling write.csv. The argument row.names should be TRUE and not True.

I also took the time to write the last observeEvent used to save the data to avoid creating two columns just for doing the subsetting.

  observeEvent(input$doSave, {
    req(
      input$columns, input$v_attribute1,
      input$v_attribute2, input$v_filter1,
      input$v_filter2, input$save_file
    )
    df <- info() %>% select(all_of(input$columns))
    df_filtered <- df %>%
      dplyr::filter(
        .data[[input$v_attribute1]] == input$v_filter1 &
          .data[[input$v_attribute2]] == input$v_filter2
      )
    fullfpath <- paste0(file.path(fpath, input$save_file), ".csv", sep = "")
    write.csv(df_filtered, fullfpath, row.names = TRUE)
    Save_done <- showNotification(paste("Data Has been saved"), duration = NULL)
  })

Full app:

library(dplyr)
library(shinyWidgets)
library(shinythemes)

fpath <- "sample_datasets"

# Define UI
ui <- fluidPage(
  theme = shinytheme("spacelab"),
  navbarPage(
    "Display Data",
    tabPanel(
      "Select File",
      sidebarPanel(
        selectInput("selectfile", "Select File", choice = list.files(fpath, pattern = ".csv")),
        mainPanel("Main Panel", dataTableOutput("ftxtout"), style = "font-size:50%") # mainPanel
      ), # sidebarPanel
    ), # tabPanel
    tabPanel(
      "Subset Data",
      sidebarPanel(
        dropdown(
          size   = "xs",
          label  = "Please Select Columns to Display",
          icon   = icon("sliders"),
          status = "primary",
          pickerInput(
            inputId  = "columns",
            #       label = "Select Columns",
            choices  = NULL,
            multiple = TRUE
          ) # pickerInput
        ), # dropdown
        selectInput("v_attribute1", "First Attribute to Filter Data", choices = NULL),
        selectInput("v_attribute2", "Second Attribute to Filter Data", choices = NULL),
        selectInput("v_filter1", "First Filter", choices = NULL),
        selectInput("v_filter2", "Second Filter", choices = NULL),
        textInput("save_file", "Save to file:", value = ""),
        actionButton("doSave", "Save Selected Data")
      ), # sidebarPanel
      mainPanel(
        tags$br(),
        tags$br(),
        h4("Data Selection"),
        dataTableOutput("txtout"),
        style = "font-size:70%"
      ) # mainPanel
    ), # Navbar 1, tabPanel
    tabPanel("Create Label", "This panel is intentionally left blank")
  ) # navbarPage
) # fluidPage


# Define server function
server <- function(input, output, session) {
  output$fileselected <- renderText({
    paste0("You have selected: ", input$selectfile)
  })

  info <- eventReactive(input$selectfile, {
    fullpath <- file.path(fpath, input$selectfile)
    read.csv(fullpath, header = TRUE, sep = ",")
  })

  observeEvent(info(), {
    df <- info()
    vars <- names(df)
    # Update select input immediately after clicking on the action button.
    updatePickerInput(session, "columns", "Select Columns", choices = vars, selected = vars[1:2])
  })

  observeEvent(input$columns, {
    vars <- input$columns
    updateSelectInput(session, "v_attribute1", "First Attribute to Filter Data", choices = vars)
    updateSelectInput(session, "v_attribute2", "Second Attribute to Filter Data", choices = vars, selected = vars[2])
  })

  observeEvent(input$v_attribute1, {
    choicesvar1 <- unique(info()[[input$v_attribute1]])
    req(choicesvar1)
    updateSelectInput(session, "v_filter1", "First Filter", choices = choicesvar1)
  })

  observeEvent(input$v_attribute2, {
    choicesvar2 <- unique(info()[[input$v_attribute2]])
    req(choicesvar2)
    updateSelectInput(session, "v_filter2", "Second Filter", choices = choicesvar2)
  })

  output$ftxtout <- renderDataTable(
    {
      head(info())
    },
    options = list(pageLength = 5)
  )

  output$txtout <- renderDataTable(
    {
      f <- info() %>% subset(select = input$columns)
      f$var1 <- f[[input$v_attribute1]]
      f$var2 <- f[[input$v_attribute2]]
      ff <- f %>% dplyr::filter(var1 == input$v_filter1 & var2 == input$v_filter2)
      fff <- ff %>% subset(select = -c(var1, var2))
      head(fff)
    },
    options = list(pageLength = 5)
  ) # renderDataTable


  # Saving data
  observeEvent(input$doSave, {
    req(
      input$columns, input$v_attribute1,
      input$v_attribute2, input$v_filter1,
      input$v_filter2, input$save_file
    )
    df <- info() %>% select(all_of(input$columns))
    df_filtered <- df %>%
      dplyr::filter(
        .data[[input$v_attribute1]] == input$v_filter1 &
          .data[[input$v_attribute2]] == input$v_filter2
      )
    fullfpath <- paste0(file.path(fpath, input$save_file), ".csv", sep = "")
    write.csv(df_filtered, fullfpath, row.names = TRUE)
    showNotification(paste("Data Has been saved"), duration = NULL)
  })
} # server

# Create Shiny object
shinyApp(ui = ui, server = server)

Save results from dynamically filtered data to a csv file

1 Answers