Блестящий | Динамический интерфейс и суммировать ввод в DF - PullRequest
0 голосов
/ 10 сентября 2018

Целью является создание приложения R-Shiny с динамическим пользовательским интерфейсом. Я хочу попросить пользователя выбрать некоторые переменные (selectInput). В моем случае Outflow1, Outflow2, Outflow 3, Inflow1, Inflow2 ... Эти входы являются необязательными. Таким образом, пользователь выбирает вход, так что отображается новый числовой ввод (insertUI). Затем пользователь выбирает значение в добавленном numericInput. Я хотел бы использовать значения и умножить их на значение (например, 0,85) в зависимости от выбранного входа (Outflow1 = 0,85, Inflow2 = 0,7 и т. Д.)

Как я могу собрать всю информацию из числовых входов и умножить их на основе выбора ввода с моим желаемым значением? Также я хочу сделать таблицу со сводкой взвешенных значений.

Моя ui.R функция показана ниже.

library(shiny) 

ui <- fluidPage( 
 sidebarLayout(

  wellPanel(checkboxInput("OUTFLOWBT", "OUTFLOW",
                          value = FALSE),

            uiOutput("OUTFLOW"),
            uiOutput("insertOUTFLOWBtn")),

  wellPanel(checkboxInput("INFLOWBT", "INFLOW",
                          value = FALSE),

            uiOutput("INFLOW"),
            uiOutput("insertINFLOWBtn")),

  uiOutput("insertBtnrmv"),

  wellPanel(tags$div(id = 'placeholder1'),
            tags$div(id = 'placeholder2'),
            tags$div(id = 'placeholder3'),
            tags$div(id = 'placeholder4'))

),

# Show a plot of the generated distribution
mainPanel(
  tableOutput('table')  
) )

Моя server.R функция, как показано ниже:

server <- function(input, output, session) {


  output$OUTFLOW <- renderUI({
    if (isTRUE(input$OUTFLOWBT))
      selectInput(inputId = "OUTFLOW",
                  label = "OUTFLOW",
                  choices = c("","OUTFLOW1", "OUTFLOW2", "Others"))

  })
  output$insertOUTFLOWBtn <- renderUI({
    if (isTRUE(input$OUTFLOWBT))
      actionButton('insertOUTFLOWBtn', '+')

  })
  observeEvent((input$insertOUTFLOWBtn),{

    switch(input$OUTFLOW, 

           "OUTFLOW1" =  insertUI(
             selector = "#placeholder2",
             where = "afterEnd", numericInput("OUTFLOW1", "OUTFLOW1",
                                              value = 0)),

           "OUTFLOW2" =   insertUI(
             selector = "#placeholder2",
             where = "afterEnd", numericInput("OUTFLOW2", "OUTFLOW2",
                                              value = 0)),
           "Others" =  insertUI(
             selector = "#placeholder2",
             where = "afterEnd", tags$div(
               tagList(numericInput("OutflowsOth", "Other Outflow",
                                    value = 0),
                       sliderInput("OutflowOthP", "Other Outflow Percentage",
                                   min = 0, max = 100, value = 100)))))

  })
  output$INFLOW <- renderUI({
    if (isTRUE(input$INFLOWBT))
      selectInput(inputId = "INFLOW",
                  label = "INFLOW",
                  choices = c("","INFLOW1", "INFLOW2", "Others"))

  })
  output$insertINFLOWBtn <- renderUI({
    if (isTRUE(input$INFLOWBT))
      actionButton('insertINFLOWBtn', '+')



  })

  observeEvent((input$insertINFLOWBtn),{
    btn <- input$insertHQLABtn
    id <- paste0('txt', btn)
    switch(input$INFLOW, 

           "INFLOW1" =  insertUI(
             selector = "#placeholder3",
             where = "afterEnd", numericInput("INFLOW1", "INFLOW1",
                                              value = 0)),

           "INFLOW2" =   insertUI(
             selector = "#placeholder3",
             where = "afterEnd", numericInput("INFLOW2", "INFLOW2",
                                              value = 0)),
           "Others" =  insertUI(
             selector = "#placeholder3",
             where = "afterEnd", tags$div(
               tagList(numericInput("INFLOWOth", "Other Inflow",
                                    value = 0),
                       sliderInput("INFLOWOthP", "Other Inflow Percentage",
                                   min = 0, max = 100, value = 100)))))

  })

}

shinyApp(ui = ui, server = server)

Чтобы дать вам представление о пользовательском интерфейсе, посмотрите на момент: введите описание изображения здесь

...