根据文件选择保存和加载用户选择-RShiny

时间:2018-10-28 15:42:55

标签: shiny shiny-server shiny-reactivity

我正在尝试创建一个简单的应用程序,充当GUI来研究具有相同变量但具有不同版本和内容的不同文件。我无法在每个用户打开该应用程序的地方提供一个应用程序,而不必在他们离开的地方再次输入其参数。我希望他们能够保存他们的参数,并在他们返回应用程序时再次调出它们。

我在这里提供示例代码,但是实际应用中输入和绘图的数量要多得多。我想知道是否有解决方案来保存这些从属的输入和输出。

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. 输入csv文件将始终存储在 “ / home / user / Documents / Shiny /”
  2. 用户只需点击“保存到 文件:”,它应将用户选择保存在“ sample.RData”中 位于相同的“ / home / user / Documents / Shiny /”中。因此,我想提供一个selectinput,用户也可以选择.RData文件。
  3. 用户还应该能够在Mainpanel上保存用于修改图表的输入

问题:-

  1. 上面给出的大多数代码都可以正常工作,但是如何保存#Display子类型。
  2. 如果我再添加一个像Type和Subtype这样的依赖列表会怎样?
  3. 此外,如果我能获得有关该解决方案是否适用于多个选择输入的帮助吗?

对代码的任何帮助将不胜感激。

虚拟数据:-

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")

每种类型下有更多子类型(葡萄酒,茶点)。我无法通过上述代码检索Subtype值,但是,当我加载Sample.RData时,我可以看到var2 =我选择的值。

我想知道如何保存这些值。

1 个答案:

答案 0 :(得分:1)

这是您代码的有效版本。您的问题是同时使用renderUI和updateSelectInput。每次您尝试更新selectInput时,都会立即重新呈现它,以使更改不可见。 我建议在UI中渲染selectInput(我为“ var2”所做的),并仅使用updateSelectInput。 (如果您确实要继续构建自己的书签。)

最诚挚的问候

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)