Пожалуйста, найдите рабочий код ниже.
По сути, есть 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)