-->

Save and Load user selections based on file select

2019-08-29 20:06发布

问题:

I am trying to create simple app that acts as a GUI for studying different files having same variables but with different version and content. I am unable to give an app where every time the user opens the app they dont have to enter in their parameters again where they left off. I'd like them to be able to save their parameters and bring them up again when they go back to the app.

I am giving my sample code here, however the number of inputs and plots are far more in the actual app. I want to know if there is any solution to save these dependent inputs and outputs.

library(shiny)
library(pryr)

ui = shinyUI(fluidPage(

  # Application title
  titlePanel("Example Title"),

  # Sidebar structure
  sidebarLayout(
    sidebarPanel(
      textInput("save_file", "Save to file:", value="sample.RData"),
      actionButton("save", "Save input value to file"),
      uiOutput("load"),
      uiOutput("file"),
      uiOutput("mytype"),
      uiOutput("mysubtype")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      tabsetPanel(id="tab",
                  tabPanel(
                    "Plot",
                    plotOutput("distPlot"),
                    checkboxInput(inputId = "density",
                                  label = strong("Show Adjustment Factors"),
                                  value = FALSE),
                    conditionalPanel(condition = "input.density == true",
                                     sliderInput(inputId = "bandwidth",
                                                 label = "Width adjustment: ",
                                                 min = 0.5, max = 4, value = 1, step = 0.1),
                                     radioButtons("mycolor", "Color Adjustment: ",
                                                  choices = c(Red = "red", Black = "black", Blue = "blue"),selected = "black", inline = TRUE)
                    )),
                  tabPanel("Summary",
                           h3(textOutput("label")),
                           verbatimTextOutput("summary")
                  )
      ))

  )
)
)

server = function(input, output, session) {
  # render a selectInput with all RData files in the specified folder
  output$load <- renderUI({
    choices <- list.files("/home/user/Documents/Shiny/", pattern="*.RData")
    selectInput("input_file", "Select input file", choices)
  })

  # render a selectInput with all csv files in the specified folder so that user can choose the version
  output$file <- renderUI({
    choices.1 <- list.files("/home/user/Documents/Shiny/", pattern="*.csv")
    selectInput("input_csv", "Select csv file", choices.1)
  })

  # Load a csv file and update input
  data = eventReactive(input$input_csv, {
    req(input$input_csv)
    read.csv(paste0("/home/user/Documents/Shiny/",input$input_csv),
             header = TRUE,
             sep = ",")
  })

  #Display Type - Types may differ based on file selection
  output$mytype <- renderUI({
    selectInput("var1", "Select a type of drink: ", choices = levels(data()$Type))
  })

  #Display SubType - This would be dependent on Type Selection
  output$mysubtype <- renderUI({
    selectInput("var2", "Select the SubType: ", choices = as.character(data()[data()$Type==input$var1,"Subtype"]))
  })

  # Save input when click the button
  observeEvent(input$save, {
    validate(
      need(input$save_file != "", message="Please enter a valid filename")
    )
    mycolor <- input$mycolor
    mytype = input$var1
    mysubtype = input$var2
    density <- input$density
    bandwidth <- input$bandwidth
    save(bandwidth, density,  mycolor, mytype, mysubtype,
         file=paste0("/home/user/Documents/Shiny/", input$save_file))
    choices <- list.files("/home/user/Documents/Shiny/", pattern="*.RData")
    updateSelectInput(session, "input_file", choices=choices)

    choices.1 <- list.files("/home/user/Documents/Shiny/", pattern="*.csv")
    updateSelectInput(session, "input_csv", choices=choices.1)
  })
  # Load an RData file and update input
  # input$var1, input$var2, input$density, input$bandwidth, input$mycolor),
  observeEvent(c(input$input_file), 
               {
    load(paste0("/home/user/Documents/Shiny/",input$input_file))
    updateSelectInput(session, "var1", choices = levels(data()$Type), selected = mytype)
    updateSelectInput(session, "var2", choices = as.character(data()[data()$Type==mytype,"Subtype"]), selected = mysubtype)
    updateCheckboxInput(session, "density", value = density)
    updateSliderInput(session, inputId = "bandwidth", value=bandwidth)
    updateRadioButtons(session, "mycolor", choices = c(Red = "red", Black = "black", Blue = "blue"), selected = mycolor, inline = TRUE)
  })

  output$distPlot <- renderPlot({

    # generate plot
    x = data()[data()$Type == input$var1 & data()$Subtype == input$var2, c("Alcohol_Content","Price")]
    plot(x$Alcohol_Content, x$Price, type = "l", xlab = "Alcohol content", ylab = "Price",
         main = "Sample Plot",
         col="red",
         lwd=1.5)
    if (input$density)
      plot(x$Alcohol_Content, x$Price, type = "p", xlab = "Alcohol content", ylab = "Price",
           main = "Sample Plot",
           col=input$mycolor,
           lwd=input$bandwidth)


  })


  output$summary <- renderText(summary(data()))

}


shinyApp(ui, server)
  1. The Input csv files would be always stored in "/home/user/Documents/Shiny/"
  2. The User could just click "Save to file:" and it should save the user selections inside "sample.RData" located in same "/home/user/Documents/Shiny/". Hence I want to give a selectinput where user can choose the .RData file also.
  3. The user should also be able to save the inputs on Mainpanel which they would use to modify the chart

Questions:-

  1. Most of the code works fine given above but how can I save #Display Subtype.
  2. What happens if I add one more dependent list like Type and Subtype?
  3. And also if I can get some help on whether the solution would work for multiple select inputs?.

Any help on the code would be really be appreciated.

Dummy Data:-

x = data.frame(Type=rep(c("WINE"), 9), Subtype=rep(c("TABLE WINE RED", "TABLE WINE WHITE", "MONTILLA"), each=3), Alcohol_content= c(14, 11.5, 12, 11, 13.5, 11, 12.5, 12, 11.5), Price = c(30.99, 32.99, 29.99, 33.99, 36.99, 34.99, 119, 32.99, 13.99))
y = data.frame(Type=rep(c("REFRESHMENT"), 9), Subtype=rep(c("CIDER ALL", "SPIRIT", "BEER"), each=3), Alcohol_content= c(5, 5.2, 7, 5.3, 6.9, 5, 5, 6, 5), Price = c(9.99, 9.99, 8.99, 9.95, 3.49, 9.99, 12.99, 13.49, 21.99))
bcl_data1 = rbind(x, y)
write.csv(bcl_data1, "bcl_data1.csv")

There are many more Subtypes under each Type (Wine , Refreshment). I am somehow not able to retrieve the Subtype value through above code, However when I load Sample.RData I can see var2 = my selected value.

I would like to know how save these values please.

回答1:

Here is a working version of your code. Your problem was the concurrent use of renderUI and updateSelectInput. Everytime you tried to update your selectInput it was re-rendered right away so that the change wasn't visible. I'd recommend to render the selectInput's in the UI (which I did for "var2") and use updateSelectInput only. (If you really want to continue building your own bookmarks.)

Best regards

library(shiny)
library(pryr)

if(!file.exists("bcl_data1.csv")){
  x = data.frame(Type=rep(c("WINE"), 9), Subtype=rep(c("TABLE WINE RED", "TABLE WINE WHITE", "MONTILLA"), each=3), Alcohol_content= c(14, 11.5, 12, 11, 13.5, 11, 12.5, 12, 11.5), Price = c(30.99, 32.99, 29.99, 33.99, 36.99, 34.99, 119, 32.99, 13.99))
  y = data.frame(Type=rep(c("REFRESHMENT"), 9), Subtype=rep(c("CIDER ALL", "SPIRIT", "BEER"), each=3), Alcohol_content= c(5, 5.2, 7, 5.3, 6.9, 5, 5, 6, 5), Price = c(9.99, 9.99, 8.99, 9.95, 3.49, 9.99, 12.99, 13.49, 21.99))
  bcl_data1 = rbind(x, y)
  write.csv(bcl_data1, "bcl_data1.csv")
}


settings_path <- getwd()
# settings_path <- "/home/user/Documents/Shiny/"

ui = shinyUI(fluidPage(

  # Application title
  titlePanel("Example Title"),

  # Sidebar structure
  sidebarLayout(
    sidebarPanel(
      textInput("save_file", "Save to file:", value="sample.RData"),
      actionButton("save", "Save input value to file"),
      p(),
      p(),
      uiOutput("load"),
      uiOutput("file"),
      uiOutput("mytype"),
      selectInput("var2", "Select the SubType: ", choices = NULL)
    ),

    # Show a plot of the generated distribution
    mainPanel(
      tabsetPanel(id="tab",
                  tabPanel(
                    "Plot",
                    plotOutput("distPlot"),
                    checkboxInput(inputId = "density",
                                  label = strong("Show Adjustment Factors"),
                                  value = FALSE),
                    conditionalPanel(condition = "input.density == true",
                                     sliderInput(inputId = "bandwidth",
                                                 label = "Width adjustment: ",
                                                 min = 0.5, max = 4, value = 1, step = 0.1),
                                     radioButtons("mycolor", "Color Adjustment: ",
                                                  choices = c(Red = "red", Black = "black", Blue = "blue"),selected = "black", inline = TRUE)
                    )),
                  tabPanel("Summary",
                           h3(textOutput("label")),
                           verbatimTextOutput("summary")
                  )
      ))

  )
)
)

server = function(input, output, session) {
  # render a selectInput with all RData files in the specified folder
  last_save_path <- file.path(settings_path, "last_input.backup")
  if(file.exists(last_save_path)){
    load(last_save_path)
    if(!exists("last_save_file")){
      last_save_file <- NULL
    }
  } else {
    last_save_file <- NULL
  }

  if(!is.null(last_save_file)){
   updateTextInput(session, "save_file", "Save to file:", value=last_save_file)
  }

  output$load <- renderUI({
    choices <- list.files(settings_path, pattern="*.RData")
    selectInput("input_file", "Select input file", choices, selected = last_save_file)
  })

  # render a selectInput with all csv files in the specified folder so that user can choose the version
  output$file <- renderUI({
    choices.1 <- list.files(settings_path, pattern="*.csv")
    selectInput("input_csv", "Select csv file", choices.1)
  })

  # Load a csv file and update input
  csv_data = eventReactive(input$input_csv, {
    req(input$input_csv)
    read.csv(file.path(settings_path,input$input_csv),
             header = TRUE,
             sep = ",")
  })

  #Display Type - Types may differ based on file selection
  output$mytype <- renderUI({
    req(csv_data())
    selectInput("var1", "Select a type of drink: ", choices = unique(csv_data()$Type))
  })

  #Display SubType - This would be dependent on Type Selection
  observeEvent(input$var1, {
    req(csv_data())
    req(input$var1)
    updateSelectInput(session, "var2", "Select the SubType: ", choices = as.character(csv_data()[csv_data()$Type==input$var1,"Subtype"]), selected = isolate(input$var2))
  })

  # Save input when click the button
  observeEvent(input$save, {
    validate(
      need(input$save_file != "", message="Please enter a valid filename")
    )

    last_save_file <- input$save_file
    save(last_save_file,  file=last_save_path)

    mycolor <- input$mycolor
    mytype = input$var1
    mysubtype = input$var2
    density <- input$density
    bandwidth <- input$bandwidth
    save(bandwidth, density,  mycolor, mytype, mysubtype,
         file=file.path(settings_path, input$save_file))
  })

  # Load an RData file and update input
  observeEvent(input$input_file, {
    req(input$input_file)
    load(file.path(settings_path, input$input_file))
    updateSelectInput(session, "var1", choices =  unique(csv_data()$Type), selected = mytype)
    updateSelectInput(session, "var2", choices = mysubtype, selected = mysubtype)
    updateCheckboxInput(session, "density", value = density)
    updateSliderInput(session, "bandwidth", value = bandwidth)
    updateRadioButtons(session, "mycolor", choices = c(Red = "red", Black = "black", Blue = "blue"), selected = input$mycolor)
  })

  output$distPlot <- renderPlot({
    req(csv_data())
    req(input$var1)
    req(input$var2)

    # generate plot
    x = csv_data()[csv_data()$Type == input$var1 & csv_data()$Subtype == input$var2, c("Alcohol_content",  "Price")]
    if(nrow(x) > 0){
      x <- x[order(x$Alcohol_content), ]
      plot(x$Alcohol_content, x$Price, type = "l", xlab = "Alcohol content", ylab = "Price",
           main = "Sample Plot",
           col="red",
           lwd=1.5)
      if (input$density)
        plot(x$Alcohol_content, x$Price, type = "p", xlab = "Alcohol content", ylab = "Price",
             main = "Sample Plot",
             col=input$mycolor,
             lwd=input$bandwidth)
    }

  })


  output$summary <- renderText(summary(csv_data()))

}

shinyApp(ui, server)