Использование switchInput на сервере - PullRequest
0 голосов
/ 04 февраля 2019

Относительно вопроса ConditionalPanel с sliderInput на основе swithcInput :

Я работаю над инструментом прогнозирования и на основе некоторых характеристик я вычислю прогноз риска.

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

Я сделал переключатель SwitchInput между KG и LB и на основе этого переключателя,люди могут либо указывать свой вес в килограммах, либо в фунтах стерлингов (поэтому не оба в одно и то же время).(KG будет по умолчанию)

Как я могу на сервере преобразовать вес в LB в KG, если переключатель находится в режиме LB, и использовать входные данные из ввода $ weightKG, если переключатель включен в KG?

Следующеене работает:

    library(shiny)
    library(shinyWidgets)

     LBtoKG <- function(weightLB){ 
          round(0.45359237*weightLB,0)}

    # Define UI ----
    ui <- fluidPage(
      titlePanel(title=div( "Risk prediction tool")),

      p("Chronic Obstructive Pulmonary Disease (COPD) is a lung problem that can affect people mainly as they get older."),

      selectInput("sex", label=p("What is your gender?"),
                  choices=list("Female"=1, "Male"=0), selected=1), 

      sliderInput("age", label=p("What is your age?"), min = 18, max = 90, value = 35),

      strong("What is your weight?"),
      br(),
      switchInput("switchweight", value = TRUE , onLabel = "kg", offLabel = "lb"),

      conditionalPanel(condition = "input.switchweight == true",
              sliderInput("weightKG", label=NULL, min = 25, max = 200, value = 75, round=0)),
            conditionalPanel(condition = "input.switchweight == false",
              sliderInput("weightLB", label=NULL, min = 55, max = 440, value = 165, round=0))
    )

            # Define server logic ----
    server <- function(input, output, session) {

  weight <- eventReactive(input$switchweight, {
  switch(input$switchweight,
          "true" = as.numeric(as.character(input$weightKG)),
           "false" = LBtoKG(as.numeric(as.character(input$weightLB))))
  })

    }

    # Run the app ----
    shinyApp(ui = ui, server = server)

Ответы [ 3 ]

0 голосов
/ 04 февраля 2019

Я думаю, что это проблема с вашим switch утверждением.Попробуйте:

switch(as.character(input$switchweight),
          "TRUE" = as.numeric(as.character(input$weightKG)),
           "FALSE" = LBtoKG(as.numeric(as.character(input$weightLB))))
0 голосов
/ 04 февраля 2019

Наконец-то нашел, как это будет работать!

Совокупность ваших ответов указала мне правильное направление.

Вот рабочий пример:

library(shiny)
library(shinyWidgets)

# Define UI ----
ui <- fluidPage(
  titlePanel(title=div( "Risk prediction tool")),

  p("Chronic Obstructive Pulmonary Disease (COPD) is a lung problem that can affect people mainly as they get older."),

  selectInput("sex", label=p("What is your gender?"),
              choices=list("Female"=1, "Male"=0), selected=1), 

  sliderInput("age", label=p("What is your age?"), min = 18, max = 90, value = 35),

  strong("What is your weight?"),
  br(),
  switchInput("switchweight", value = TRUE , onLabel = "kg", offLabel = "lb"),
    sliderInput("weight", label=NULL, min = 25, max = 200, value = 75, round=0),

  actionButton("submit", label = "Generate Prediction"),

  p('Your predicted risk (%) of developing COPD in your lifetime is:'),
  verbatimTextOutput("prediction")

)


# Define server logic ----
server <- function(input, output, session) {

   copdRisk <- function(age, sex, weight) {
    (exp(-5.00   +(-0.004*(as.numeric(as.character(age)))) 
         +(0.40*(as.numeric(as.character(sex))))
         +(0.10*(as.numeric(as.character(weight)))) # in cm!
    ))}


  observeEvent(input$switchweight, {
    if(input$switchweight){
      updateSliderInput(session, "weight", label=NULL, min = 25, max = 200, value = isolate({input$weight/2.2046226}))
    } else {
      updateSliderInput(session, "weight", label=NULL, min = 55, max = 440, value = isolate({input$weight*2.2046226}))
    }
  }, ignoreInit = TRUE)


  prediction <- observe({ 

    ## some coding that will convert LB weight in to KG when switch is on LB
    weight <- 
      if(as.character(input$switchweight) == TRUE) {input$weight
      } else {round(input$weight/2.2046226)}


    risks <- (copdRisk(age = input$age, sex=input$sex, weight=weight #WHICH needs to always in CM!
                       ))

    output$prediction <- renderText({
      round(risks, 1)})
  }) 
}

# Run the app ----
shinyApp(ui = ui, server = server)
0 голосов
/ 04 февраля 2019

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

library(shiny)
library(shinyWidgets)

# Define UI ----
ui <- fluidPage(
  titlePanel(title=div( "Risk prediction tool")),

  p("Chronic Obstructive Pulmonary Disease (COPD) is a lung problem that can affect people mainly as they get older."),

  selectInput("sex", label=p("What is your gender?"),
              choices=list("Female"=1, "Male"=0), selected=1), 

  sliderInput("age", label=p("What is your age?"), min = 18, max = 90, value = 35),

  strong("What is your weight?"),
  br(),
  switchInput("switchweight", value = TRUE , onLabel = "kg", offLabel = "lb"),

  sliderInput("weight", label=NULL, min = 25, max = 200, value = 75, round=0)
)

# Define server logic ----
server <- function(input, output, session) {

  weightKG <- reactiveVal(isolate(input$weight))

  observeEvent(input$weight, {
    if(input$switchweight){
      weightKG(round(input$weight, digits = 0))
    } else {
      weightKG(round(input$weight/2.2046226, digits = 0))
    }
    print(weightKG())
  })

  observeEvent(input$switchweight, {
    if(input$switchweight){
      updateSliderInput(session, "weight", label=NULL, min = 25, max = 200, value = isolate({input$weight/2.2046226}))
    } else {
      updateSliderInput(session, "weight", label=NULL, min = 55, max = 440, value = isolate({input$weight*2.2046226}))
    }
  }, ignoreInit = TRUE)

}

# Run the app ----
shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...