Сброс действия кнопки вывода в блестящем

Question

Я работаю над моделью прогнозирования, используя R Shiny.

В качестве входных данных у меня есть некоторые переменные для модели, такие как пол, возраст, рост .... У меня есть кнопка с надписью «Сгенерировать прогноз».

При нажатии появляется текст и цифры на основе прогноза, сделанного с помощью входных переменных.

Я также включил кнопку действия «сброс».

Я хочу, чтобы при нажатии этой кнопки все переменные переходили к исходному значению (которое уже работает) И чтобы выход, сгенерированный после кнопки «Создать прогноз», исчезал.

Моя проблема со второй частью этого желания.

Возможно ли это и как я могу удалить выход после нажатия кнопки «сброс»?

Найдите мой скрипт ниже в качестве примера (реальный скрипт более сложный). Я хотел бы, чтобы часть, указанная в «Результаты прогноза», исчезла при нажатии кнопки сброса.

library(shiny)

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

  p("Chronic Obstructive Pulmonary Disease (COPD) is a lung problem that can affect people mainly as they get older. One of the main features of COPD is a change in the airways that alters how the air is held in the lungs and the ease with which breathing occurs (the airways become 'obstructed'). This may cause breathlessness, frequent coughing, production of sputum from your chest, and chest infections."),

  selectInput("sex", label=h4("What is your gender?"),
              choices=list("Female"=0, "Male"=1), selected=0),       
  selectInput("age", label=h4("What is your age?"),
              choices=list("18"=18, "19"=19, "20"=20, "21"=21, "22"=22, "23"=23, "24"=24, "25"=25, "26"=26, "27"=27, "28"=28, "29"=29, "30"=30), selected=20),
  bsTooltip("age",
            "What is your current age in years?","right"),
  selectInput("weight", label=h4("What is your weight?"),
              choices=list("50"=50, "51"=51, "52"=52, "53"=53, "54"=54, "55"=55, "56"=56, "57"=57, "58"=58, "59"=59, "60"=60, "61"=61, "62"=62, "63"=63, "64"=64, "65"=65, "66"=66, "67"=67, "68"=68, "69"=69, "70"=70, "71"=71, "72"=72, "73"=73, "74"=74, "75"=75, "76"=76, "77"=77, "78"=78, "79"=79, "80"=80, "81"=81, "82"=82, "83"=83, "84"=84, "85"=85, "86"=86, "87"=87, "88"=88, "89"=89, "90"=90, "91"=91, "92"=92, "93"=93, "94"=94, "95"=95, "96"=96, "97"=97, "98"=98, "99"=99, "100"=100), selected=75),
  bsTooltip("weight", 
            "What is your current weight in kg?", "right"),
  selectInput("height", label=h4("What is your height?"),
              choices=list("140"=140, "141"=141, "142"=142, "143"=143, "144"=144, "145"=145, "146"=146, "147"=147, "148"=148, "149"=149, "150"=150, "151"=151, "152"=152, "153"=153, "154"=154, "155"=155, "156"=156, "157"=157, "158"=158, "159"=159, "160"=160, "161"=161, "162"=162, "163"=163, "164"=164, "165"=165, "166"=166, "167"=167, "168"=168, "169"=169, "170"=170, "171"=171, "172"=172, "173"=173, "174"=174, "175"=175, "176"=176, "177"=177, "178"=178, "179"=179, "180"=180, "181"=181, "182"=182, "183"=183, "184"=184, "185"=185), selected=170),
  bsTooltip("height",
            "What is your current height in cm?", "right"),
  br(),

  h4("Medical Disclaimer", style = "color:blue"),
  p(strong("This risk prediction tool is for general information and should not replace advice from your GP who knows your individual history.", style = "color:blue")),
  p(strong("Although we have included major risk factors, COPD can affect anyone and if you have symptoms or concerns you should speak to your doctor.", style = "color:blue")),
  p(strong("This risk score is derived from Caucasian populations and may not be as accurate for other ethnic groups.", style = "color:blue")),

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

  h2(textOutput('title')),
  h4(textOutput('label1')),
  h5(textOutput('label2')),
  verbatimTextOutput("prediction")
)


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

  submit <- FALSE
  output$title <- eventReactive(input$submit, {
    'Results of prediction'
  })
  output$label1 <- eventReactive(input$submit, {
    'COPD risk prediction score'
  })
  output$label2 <- eventReactive(input$submit, {
    'Your predicted risk (%) of developing COPD in your lifetime is:'
  })
  output$prediction <- eventReactive(input$submit, {
  round((copdRisk(weight=input$weight, height=input$height, sex=input$sex)*100), 1)
  })

  output$label5 <- eventReactive(input$submit, {
    'This means that for every 100 people sharing your characteristics '
  })  
  output$label6 <- eventReactive(input$submit, {
    'would develop COPD in their lifetime.'
  })

    observe({
    input$reset
    updateSelectInput(session, "age", selected=20)
    updateSelectInput(session, "weight", selected=75)
    updateSelectInput(session, "height", selected=170)
    updateSelectInput(session, "sex", selected=0)
    #updateActionButton(session, "submit", selected=FALSE)
  })
}

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

Answer 1

Для людей, имеющих ту же проблему, это также может быть решением: Перезапустите Shiny Session . Таким образом, все входы и выходы сбрасываются, но это занимает больше времени.

Answer 2

В моем ответе ниже я покажу, как добиться того, что вы просите. В своем ответе я использую пакет shinyjs, как для сброса входных значений, так и для скрытия / отображения результатов. Я не могу запустить ваш код, потому что есть дополнительные пакеты и функции, которые вы используете, о которых я не знаю, и сам код не является минимальным изолированным примером, поэтому вместо этого я напишу свое маленькое приложение, которое делает что-то подобное и достигает того, что вы хотите. Вот код:

library(shiny)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  numericInput("num", "Enter a number", 7),
  actionButton("submit", "Square that number!"),
  actionButton("reset", "Reset"),
  shinyjs::hidden(
    div(
      id = "results",
      h3("The square is"),
      textOutput("square")
    )
  )
)

server <- function(input, output, session) {
  output$square <- renderText({
    input$submit
    isolate(input$num * input$num)
  })

  observeEvent(input$reset, {
    shinyjs::reset("num")
    shinyjs::hide("results")
  })

  observeEvent(input$submit, {
    shinyjs::show("results")
  })
}

shinyApp(ui = ui, server = server)

Чтобы ответить на ваши два вопроса конкретно и как они решаются выше:

1. Чтобы восстановить исходные значения входов, я использую функцию shinyjs::reset(). Это гораздо лучший подход, чем обновление входных данных до определенного значения, потому что функция reset() гарантирует ее сброс на то значение, которое было изначально, тогда как ваш подход означает, что если вы измените начальное значение в пользовательском интерфейсе, вы должен не забудьте изменить его и на сервере.

2. Чтобы скрыть результаты после нажатия кнопки сброса, я обернул все пользовательский интерфейс результатов в div(id = "results", ...). Затем всякий раз, когда нажимается кнопка отправки, я использую блестящий, чтобы показать ее, а когда нажата перезагрузка, я использую блестящий, чтобы скрыть ее. Я также обернул пользовательский интерфейс в shinyjs::hidden(...), потому что вы хотите, чтобы результаты начинались как не показанные.

Оба из вышеперечисленных требуют вызова shinyjs::useShinyjs() в пользовательском интерфейсе.

Вы должны быть в состоянии построить этот пример и реализовать эти методы в более сложном приложении.

Также обратите внимание, что мой пример приложения выше делает несколько других вещей, отличных от вашего. Например, вы не должны использовать output$X <- eventReactive(...). Вы должны использовать функции рендеринга (например, renderText()) при назначении выходов.