Как мы можем обновить и вызвать div (id = "someid", class ='iny-input-checkboxgroup ')? - PullRequest
0 голосов
/ 08 ноября 2018

Если вы запустите приведенное ниже приложение в своем каталоге, нажмите «Сохранить» и перезапустите приложение, и вы заметите, что все входные данные в боковой панели сохраняются в sample.RData. Сохраненные значения также извлекаются, что нам нужно для пользователя. Если вы загрузите sample.RData в Rstudio, вы найдете значения для ввода $ CategoryA, ввода $ CategoryB и т. Д., Которые также будут сохранены, но не будут вызваны. Я не уверен, есть ли более легкий способ достигнуть этого. Если да, я в порядке. Вопросы: -

  1. Как я могу вспомнить идентификаторы входных данных группы флажков, созданные в div (id =) заявления?
  2. Это правильный способ или я тоже комплекс для цели?
  3. Я не сохраняю их должным образом. Как мне сохранить их как другие входные данные?
  4. Как я могу вызвать их из файла sample.RData, как и другие входные данные? Моя цель - предоставить пользователям динамический интерфейс, в котором они могут динамически распределять имена переменных по категориям от A до J (10 цифр). Каждое имя переменной (имя столбца) может относиться к нескольким категориям, поэтому можно установить флажок. После того, как пользователь выбрал их, кто-то может закрыть приложение и вернуться позже (версия для ПК). Когда они перезапускаются, все остальные входные параметры должны быть на месте, как в прошлый раз. С помощью этого портала я могу сохранить входные данные в sidebarpanel, но основные не возвращаются. Я даю код ниже. Однако само приложение имеет гораздо больше переменных на боковой панели и основной панели. Я ищу отчаянную помощь, чтобы сохранить эти входные идентификаторы из Div HTML. В тот момент, когда я откомментирую # updateCheckboxGroupInput (session, inputId = "CategoryA", choices = 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)
...