Как создать взаимозависимый числовой ввод в Shiny? - PullRequest
1 голос
/ 25 апреля 2019

Пожалуйста, найдите рабочий код ниже. По сути, есть 3 числовых входа, которые позволяют пользователю изменять кого-либо одновременно, а два других должны адаптироваться, что приводит к 1

A + B + C = 1 Однако, поскольку они взаимосвязаны, они кажутся нестабильными. Как мы можем сделать его стабильным и позволить пользователю изменять любую 1 переменную: A и другие 2 меняются суммированием до 1.

На основе ответа здесь создан рабочий код, как показано ниже:

Подключение взаимозависимых значений блеска ввода

Зависимые входы в блестящем приложении с R

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("Mutually Dependent Input Values"),
  sidebarLayout(
    sidebarPanel(
      numericInput("A", "A",.333),
      numericInput("B", "B",.333),
      numericInput("C", "C",.333)
    ),
    mainPanel(
      verbatimTextOutput("result")
    )
  )
)) 
server <- shinyServer(function(input, output,session) {

  observeEvent(input$A,{
    newB <- 1 - input$A - input$C 
    updateNumericInput(session, "B", value = newB) 
    newC <- 1 - input$A - input$B 
    updateNumericInput(session, "C", value = newC) 
  })
  observeEvent(input$B,{
    newC <- 1 - input$B - input$A 
    updateNumericInput(session, "C", value = newC) 
    newA <- 1 - input$B - input$C 
    updateNumericInput(session, "A", value = newA) 
  })
  observeEvent(input$C,{
    newA <- 1 - input$C - input$B 
    updateNumericInput(session, "A", value = newA) 
    newB <- 1 - input$C - input$C 
    updateNumericInput(session, "B", value = newB) 
  })


})
shinyApp(ui,server)

Как правило, пользователь может свободно обновлять любой из числовых входов: A, B или C. Другие 2 числовых входа должны адаптироваться к сумме до 1. В настоящее время, поскольку они взаимосвязаны, они кажутся нестабильными (пожалуйста, найдите приведенный выше код, чтобы восстановить ошибку)

####### Другой подход с собственным решением

ui <- fluidPage(
  column(6, 
         tags$h2("Set parameters"),
         numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1)
  ),
  column(6,
         uiOutput("ui")
  )
)

server <- function(input, output, session) {
  output$ui <- renderUI( {
    tagList(
      tags$h2("Display in %"),
      numericInput("obs1", "Label1", value = 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs2", "Label2", value = 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs2", "Label2", value = 100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
    )
  })
}

shinyApp(ui, server)   

1 Ответ

0 голосов
/ 26 апреля 2019

Вам нужно сделать две основные вещи:

  • Сначала пусть ваши начальные значения стабильны, поэтому либо их сумма должна быть 1 (0,333, 0,333, 0,334 )или, возможно, пусть начальные значения будут пустыми, что будет работать только в том случае, если у вас есть какой-либо механизм экранирования ошибок, позволяющий использовать NA или пустую строку в качестве начального значения.Как я и думал, в любом случае должна быть некоторая проверка того, что ввод является числовым, я решил использовать второй вариант, который хорошо работает с проверкой.

  • Второй способ избавиться от второгоэти бесконечные циклы наблюдения и изменения входных данных - это изменение по одному за раз, что означает:

    • при изменении A ---> изменить B,
    • при изменении B---> изменить C и
    • , если C изменилось ---> изменить A

При этом обратите внимание, что порядок изменениявход имеет значение в этом подходе, это наиболее заметно в начале, когда вы даете вводу их первый набор значений.

Возможно, есть лучший подход для решения этой проблемы, но это то, что я могу придуматьИтак, вот и все.

Пользовательский интерфейс:

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("Mutually Dependent Input Values"),
  sidebarLayout(
    sidebarPanel(
      numericInput("A", "A", NA),
      numericInput("B", "B", NA),
      numericInput("C", "C", NA)
    ),
    mainPanel(
      verbatimTextOutput("result")
    )
  )
)) 

Сервер:

server <- shinyServer(function(input, output, session) {
  sum <- reactive({
    validate(
      need(is.numeric(input$A), 'A is not a number, only numbers are allowed'),
      need(is.numeric(input$B), 'B is not a number, only numbers are allowed'),
      need(is.numeric(input$C), 'C is not a number, only numbers are allowed')
    )
    input$A + input$B + input$C})

  observeEvent(input$A,{
      newB <- 1 - input$A - input$C
      updateNumericInput(session, "B", value = newB)
  })

  observeEvent(input$B,{
      newC <- 1 - input$B - input$A
      updateNumericInput(session, "C", value = newC)
  })

  observeEvent(input$C,{
      newA <- 1 - input$C - input$B
      updateNumericInput(session, "A", value = newA)
  })

  output$result <- renderPrint({
    print(sprintf("A=%.3f      B=%.3f      C=%.3f  ---->   A + B + C = %.0f", 
                  input$A, input$B, input$C, sum()))
  })
})

Запуск:

shinyApp(ui,server)
...