Question

如果在目录中运行以下应用程序，请单击“保存”，然后重新启动该应用程序，您会注意到侧面板中的所有输入都已保存在sample.RData中。保存的值也将被调出，这是我们用户需要的。如果在Rstudio中加载sample.RData，则会找到input $ CategoryA，input $ CategoryB等的值，但也会保存但不会被调用。我不确定是否有更简单的方法可以实现这一目标。如果是的话，我很好。问题：-

如何重新调用在div（id =）中创建的复选框组输入ID 声明？
这是正确的做法还是我也做到了目标复杂吗？
我猜我没有正确保存它们。如何像其他输入一样保存它们？
如何像其他输入一样从sample.RData文件中调出它们？我的目标是为用户提供一个动态界面，在该界面中，他们可以将变量名称从A类别动态地分类为J（数字10）。每个变量名称（列名称）可以分为多个类别，因此可以使用复选框。一旦用户选择了他们，则有人可以关闭该应用程序并稍后再返回（桌面版本）。当他们重新启动时，所有其他输入选择都应该像上次一样就位。在此门户网站的帮助下，我能够将输入保存在侧边栏面板中，但是主面板上的输入却未被召回。我在下面给出代码。但是，实际的应用程序在侧栏面板和主面板上有更多变量。我正在寻求绝望的帮助，以从div html保存这些输入ID。当我取消注释＃updateCheckboxGroupInput（session，inputId =“ CategoryA”，选择= CategoryA，selected = CategoryA）时，它说未找到对象CategoryA。我正在尝试更新复选框输入（上面的注释行），但无济于事。如果我可以回忆起一次输入，则可以对B类到J类尝试相同的操作。

以下应用的代码：-

library(shiny)
library(pryr)
library(shinyjs)
library(shinyFiles)
library(DT)
library(stringr)
library(data.table)

if(!file.exists("mydata.csv")){
  x = data.frame(Column1=seq(as.Date('2018/11/01'), as.Date('2018/11/20'), by="day"),
                 Column2=rep(c("TypeA", "TypeB"), each=10),
                 Column3= rep(c(14, 11.5, 12, 11, 13.5, 11, 12.5, 12, 11.5, 6.5), each=2), 
                 Column4 = rep(c(30.99, 32.99, 29.99, 33.99, 36.99, 34.99, 11.99, 32.99, 13.99, 16.99), each=2),
                 Column5 = rep(c(10.99, 12.99, 19.99, 13.99, 16.99, 14.99, 14.99, 12.94, 13.90, 16.80), each=2),
                 Column6 = rep(c(20.99, 22.99, 29.99, 23.99, 26.99, 24.99, 24.99, 22.94, 23.90, 26.80), each=2),
                 Column7 = rep(c(50.99, 52.99, 59.99, 53.99, 56.99, 54.99, 54.99, 52.94, 53.90, 56.80), each=2),
                 Column8 = rep(c(60.99, 62.99, 69.99, 63.99, 66.99, 64.99, 64.99, 62.94, 63.90, 66.80), each=2))
  write.csv(x, "mydata.csv")
}

settings_path <- getwd()

ui = shinyUI(
  fluidPage(
    sidebarLayout(
      sidebarPanel(
        textInput("save_file", "Save to file:", value="sample.RData"),
        actionButton("save", "Save input value to file"),
        p(),
        p(),
        uiOutput("load"),
        uiOutput("file"),
        p(),
        selectInput("Browse", label = "Time-Period", choices = c("","Weekly", "Monthly", "Quartely" , "Yearly"), selected = NULL),
        uiOutput('select1'),
        textInput("text1", label = "Type your selection",value = ""),
        p(),
        uiOutput('select2'),
        textInput("text2", label = "Type your selection",value = ""),
        p(),
        uiOutput('select3'),
        textInput("text3", label = "Type your selection",value = ""),
        p(),
        uiOutput('select4'),
        textInput("text4", label = "Type your selection",value = ""),
        p(),
        uiOutput('select5'),
        textInput("text5", label = "Type your selection",value = ""),
        p()

      ),
      mainPanel(
        tabsetPanel(
          tabPanel("Category Selection",
                   fluidPage(
                     fluidRow(
                       column(12,
                              wellPanel(
                                div(id="CategoryA",class='shiny-input-checkboxgroup',
                                    div(id="CategoryB",class='shiny-input-checkboxgroup',
                                        div(id="CategoryC",class='shiny-input-checkboxgroup',
                                            div(id="CategoryD",class='shiny-input-checkboxgroup',
                                                div(id="CategoryE",class='shiny-input-checkboxgroup',
                                                    div(id="CategoryF",class='shiny-input-checkboxgroup',
                                                        div(id="CategoryG",class='shiny-input-checkboxgroup',
                                                            div(id="CategoryH",class='shiny-input-checkboxgroup',
                                                                div(id="CategoryI",class='shiny-input-checkboxgroup',
                                                                    div(id="CategoryJ",class='shiny-input-checkboxgroup',
                                                                        DT::dataTableOutput(outputId = "mytable"),
                                    style = "font-size : 80%"))))))))))
                              )))),
                   verbatimTextOutput('sel')
          )

        )
      )
    )
  )
)

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
  data = eventReactive(input$input_csv, {
    req(input$input_csv)
    read.csv(file.path(settings_path,input$input_csv),
             header = TRUE,
             sep = ",")
  })

  variables <- reactive(colnames(data()[-1]))
  toolkit <- reactiveValues()
  #Display Names of the selected dataset - First Set
  output$select1 <- renderUI({
    req(data())
    req(variables())
    selectInput(inputId = "my_btn1", label = "Variable:",choices = c("", variables()),multiple =F)
  })

  #Display Text of the selected variable - First Set
  observeEvent(input$my_btn1, {
    req(data())
    req(input$my_btn1)
    updateTextInput(session, inputId = "text1", label = "Type your selection", value = isolate(input$text1))
  })

  #Display Time Dimension Variable
  observeEvent(input$my_btn1, {
    req(data())
    req(input$my_btn1)
    req(input$text1)
    updateSelectInput(session, inputId = "Browse", label = "Time-Period", choices = c("","Weekly", "Monthly", "Quartely" , "Yearly"), selected  = isolate(input$Browse))
  })


  #Display Names of the selected dataset - Second Set
  output$select2 <- renderUI({
    req(data())
    req(variables())
    selectInput(inputId = "my_btn2", label = "Variable:",choices = c("", variables()),multiple =F)
  })

  #Display Text of the selected variable - Second Set
  observeEvent(input$my_btn2, {
    req(data())
    req(input$my_btn2)
    updateTextInput(session, inputId = "text2", label = "Type your selection", value = isolate(input$text2))
  })

  #Display Names of the selected dataset - Third Set
  output$select3 <- renderUI({
    req(data())
    req(variables())
    selectInput(inputId = "my_btn3", label = "Variable:",choices = c("", variables()),multiple =F)
  })


  #Display Text of the selected variable - Third Set
  observeEvent(input$my_btn3, {
    req(data())
    req(input$my_btn3)
    updateTextInput(session, inputId = "text3", label = "Type your selection", value = isolate(input$text3))
  })

  #Display Names of the selected dataset - Fourth Set
  output$select4 <- renderUI({
    req(data())
    req(variables())
    selectInput(inputId = "my_btn4", label = "Variable:",choices = c("", variables()),multiple =F)
  })

  #Display Text of the selected variable - Fourth Set
  observeEvent(input$my_btn4, {
    req(data())
    req(input$my_btn4)
    updateTextInput(session, inputId = "text4", label = "Type your selection", value = isolate(input$text4))
  })

  #Display Names of the selected dataset - Fifth Set
  output$select5 <- renderUI({
    req(data())
    req(variables())
    selectInput(inputId = "my_btn5", label = "Variable:",choices = c("", variables()),multiple =F)
  })

  #Display Text of the selected variable - Fifth Set
  observeEvent(input$my_btn5, {
    req(data())
    req(input$my_btn5)
    updateTextInput(session, inputId = "text5", label = "Type your selection", value = isolate(input$text5))
  })

  observeEvent({
    input$my_btn1
    input$my_btn2
    input$my_btn3
    input$my_btn4
    input$my_btn5},{
      row_names <- variables()[!(variables() %in% c(input$my_btn1,input$my_btn2,input$my_btn3,input$my_btn4,input$my_btn5))]
      mymatrix <- matrix((1:10), nrow = length(row_names), ncol = 10, byrow = TRUE,dimnames = list(row_names, c("CategoryA",
                                                                                                                "CategoryB", "CategoryC", "CategoryD", "CategoryE", "CategoryF","CategoryG",
                                                                                                                "CategoryH","CategoryI", "CategoryJ")))
      ##Put the for loop here
      for (i in seq_len(nrow(mymatrix))) {
        mymatrix[i, 1] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryA", row_names[i]
        )
        mymatrix[i, 2] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryB", row_names[i]
        )
        mymatrix[i, 3] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryC", row_names[i]
        )
        mymatrix[i, 4] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryD", row_names[i]
        )
        mymatrix[i, 5] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryE", row_names[i]
        )
        mymatrix[i, 6] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryF", row_names[i]
        )
        mymatrix[i, 7] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryG", row_names[i]
        )
        mymatrix[i, 8] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryH", row_names[i]
        )
        mymatrix[i, 9] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryI", row_names[i]
        )
        mymatrix[i, 10] = sprintf(
          ifelse(i == 1,
                 '<input type="checkbox" name="%s" value="%s" checked="checked"/>',
                 '<input type="checkbox" name="%s" value="%s"/>'),
          "CategoryJ", row_names[i]
        )
      }
      toolkit$mymatrix <- mymatrix

      # updateCheckboxGroupInput(session, inputId = "CategoryA", choices = isolate(input$CategoryA), selected = isolate(input$CategoryA))
    })


  output$mytable = DT::renderDataTable(toolkit$mymatrix,
                                       escape = FALSE, selection = 'none', server = FALSE, class = 'cell-border stripe',
                                       options = list( initComplete = JS(
                                         "function(settings, json) {",
                                         "$(this.api().table().header()).css({'background-color': '#0B3861', 'color': '#fff'});",
                                         "}"),ordering = FALSE, scroller = TRUE, scrollX = TRUE,
                                         autoWidth = TRUE, scrollY = "525px", bPaginate = FALSE,
                                         searching = FALSE, columnDefs = list(list(className = 'dt-center', targets = "_all"))),
                                       callback = JS("table.rows().every(function(i, tab, row) {
                                                var $this = $(this.node());
                                                $this.attr('id', this.data()[0]);
                                                $this.addClass('shiny-input-radiogroup');});
                                                Shiny.unbindAll(table.table().node());
                                                Shiny.bindAll(table.table().node());
                                                $(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});")
  )

  output$sel <- renderPrint({
    str(input$CategoryA)
    str(input$CategoryB)
    str(input$CategoryC)
    str(input$CategoryD)
    str(input$CategoryE)
    str(input$CategoryF)
    str(input$CategoryG)
    str(input$CategoryH)
    str(input$CategoryI)
    str(input$CategoryJ)
  }
    )




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

    #This should recall the second dependent list
    last_save_file <- input$save_file
    save(last_save_file,  file=last_save_path)

    my_btn1 = input$my_btn1
    text1 = input$text1
    Browse = input$Browse
    my_btn2 = input$my_btn2
    text2 = input$text2
    my_btn3 = input$my_btn3
    text3 = input$text3
    my_btn4 = input$my_btn4
    text4 = input$text4
    my_btn5 = input$my_btn5
    text5 = input$text5
    CategoryA = input$CategoryA

    save(my_btn1, text1, Browse, my_btn2, text2, my_btn3, text3, my_btn4, text4, my_btn5, text5,
         CategoryA,
         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, inputId = "my_btn1", label = "Variable:", choices = c("", variables()), selected = my_btn1)
    updateTextInput(session, inputId = "text1", label = "Type your selection", value  = text1)
    updateSelectInput(session, inputId = "Browse", label = "Time-Period", choices = Browse, selected  = Browse)
    updateSelectInput(session, inputId = "my_btn2", label = "Variable:", choices = c("", variables()), selected = my_btn2)
    updateTextInput(session, inputId = "text2", label = "Type your selection", value  = text2)
    updateSelectInput(session, inputId = "my_btn3", label = "Variable:", choices = c("", variables()), selected = my_btn3)
    updateTextInput(session, inputId = "text3", label = "Type your selection", value  = text3)
    updateSelectInput(session, inputId = "my_btn4", label = "Variable:", choices = c("", variables()), selected = my_btn4)
    updateTextInput(session, inputId = "text4", label = "Type your selection", value  = text4)
    updateSelectInput(session, inputId = "my_btn5", label = "Variable:", choices = c("", variables()), selected = my_btn5)
    updateTextInput(session, inputId = "text5", label = "Type your selection", value  = text5)
    # updateCheckboxGroupInput(session, inputId = "CategoryA", choices = CategoryA, selected = CategoryA)


  })

}

shinyApp(ui = ui, server = server)

我们如何更新和调用div（id =“ someid”，class ='shiny-input-checkboxgroup'）？

0 个答案: