Как отображать динамические c пользовательские интерфейсы на основе выбора пользователя с блестящей - PullRequest
Новая
       23

Как отображать динамические c пользовательские интерфейсы на основе выбора пользователя с блестящей

0 голосов
/ 02 марта 2020

Учитывая набор блестящих пользовательских интерфейсов и их отличающиеся аргументы (для чтения из rdf, здесь даны в виде явных списков), как пользователь может выбрать желаемый тип ввода (для модели данных с множеством различных входов, все предварительно заданные со значениями по умолчанию), которые нужно изменить? 

library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = "seq(1,20,1)", selected = 10),
                    list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = "c(25,75)" ),
                    list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
                    list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        pickerInput(inputId = "pkInp01",
                    label = "Select CF-Model Inputs for change",
                    choices =  inputWidget,
                    selected = inputWidget[1:2],
                    multiple = TRUE,
                    options = list(`actions-box` = TRUE,
                                   `selected-text-format`= "count",
                                   `count-selected-text` = "{0} inputs of {1} selected") ),
       uiOutput("inpUI"),
        ),
      mainPanel(
        dataTableOutput("table01")
        )
      )
    )
  #-----------------generateArguments4invoke_map---------------------------. 
  server <- function(input, output, session) {
    #B: obs <- reactiveValues(
    #A: pckdWdgt <- inputWidget[match(input$pkInp01, inputWidget)],
    #A: wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
    #B: )
    #B: observe({
    #B:   obs$pW01 = inputWidget[match(input$pkInp01, inputWidget)]
    #B:   obs$wA02 = inpWidgArgs[match(input$pkInp01, inputWidget)]
    #B:   })
    #------------------renderAsManyInputUisAsPicked------------
    output$inpUI <- renderUI({
      #A: invoke_map(match.fun(pckdWdgt), wdgtArgs)
      #B: invoke_map(match.fun(obs$pW01), obs$WA02)
      invoke_map(list(selectInput, sliderInput), list(
        list(inputId = "inpUI01", label = "selectInput01", choices = seq(1,20,1), selected = 10),
        list(inputId = "inpUI02", label = "sliderInput02", min= 0, max = 100, value = c(25,75) )
        )
        )
    })
  }
}
#-----------------------------------------------------
shinyApp(ui, server)

С помощью map () или invoke_map () должна быть возможность передать тип функции / UIinput и ее аргументы (сравните: https://hadley.shinyapps.io/ms-render-palette-full).

Два подхода (A: и B :) ниже терпят неудачу (возможная причина: окружение / пространство имен?) Любое предложение высоко ценится.

Большое спасибо заранее

1 Ответ

0 голосов
/ 03 марта 2020

Я убрал часть вашего кода и создал решение. Для начала несколько мелких вещей: Аргумент choices в seInp01 не должен быть между кавычками То же самое касается аргумента значения в slInp01. Наконец, за вашим аргументом uiOutput в пользовательском интерфейсе стоит запятая. Для функциональности кода я просто поместил некоторые коды, которые вы уже придумали, в нужное место, у вас была правильная идея.

Код: 

library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = seq(1,20,1), selected = 10),
                    list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = c(25,75) ),
                    list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
                    list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        pickerInput(inputId = "pkInp01",
                    label = "Select CF-Model Inputs for change",
                    choices =  inputWidget,
                    selected = inputWidget[1:2],
                    multiple = TRUE,
                    options = list(`actions-box` = TRUE,
                                   `selected-text-format`= "count",
                                   `count-selected-text` = "{0} inputs of {1} selected") ),
        uiOutput("inpUI")
      ),
      mainPanel(
        dataTableOutput("table01")
      )
    )
  )
  #-----------------generateArguments4invoke_map---------------------------. 
  server <- function(input, output, session) {
    #------------------renderAsManyInputUisAsPicked------------
    output$inpUI <- renderUI({
      wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
      invoke_map(input$pkInp01, wdgtArgs)
    })
  }
}
#-----------------------------------------------------
shinyApp(ui, server)
...