В R shiny, как обратить цепочку реактивности вспять?

#r #shiny #shiny-reactivity

Вопрос:

В приведенном ниже коде MWE 1-е поле ввода отображается и отображается по умолчанию. Значение по умолчанию отображается и выводится на график, и пользователь может его изменить. При нажатии на флажок «Показать» отображается 2-е поле ввода, значение которого связано с 1-м полем ввода, и в это 2-е поле ввода пользователь может дополнительно вставить другое значение, которое затем имеет приоритет над 1-м вводом и отображается на графике. (В полном приложении, из которого это извлечено, 2-е поле ввода выполняет другие вычисления, поэтому то, что показано здесь, упрощено). Таким образом, цепочка реактивности, где работает: input1 -> input2, при этом input2 имеет приоритет над input1.

Однако, как мне обратить вспять эту цепочку реактивности? Таким образом, значение, представленное во вводе 1, изменяется, чтобы отразить то, что было введено во ввод2? В приведенном ниже MWE я попытался сделать это в отмеченной строке << comment/uncomment this line to see , но когда эта строка не помечена (что позволяет выполнить мою попытку решения), 2-е поле ввода скрыто, даже если флажок «Показать» для этого 2-го ввода остается включенным для показа. Это 2-е поле ввода должно продолжать отображаться до тех пор, пока флажок не будет снят.

Смотрите также изображение ниже.

Код MWE:

 library(shiny)
library(shinyjs)
library(shinyMatrix)

### Checkbox matrix ###
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "reset")
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")
### Checkbox matrix ###

xDflt <- 5
userInput <- function(inputId,x,y){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c(y),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output){
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      userInput("input1",
                # if(isTruthy(input2())){input$input2[1,1]} else # << comment/uncomment this line to see
                  {xDflt},
                "1st input"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  ### Begin checkbox matrix ###
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
      rownames = TRUE, align = "c",
      sanitize.text.function = function(x) x
    )

  observeEvent(input[["show1"]], {
    if(input[["show1"]] ){
      shinyjs::show("secondInput")
    } else {
      shinyjs::hide("secondInput")
    }
  })
  ### End checkbox matrix ###
 
  output$secondInput <- renderUI({
    req(input1())
    userInput("input2",input$input1[1,1],"2nd input")
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })

}

shinyApp(ui, server)
 

введите описание изображения здесь

Ответ №1:

Ваши флажки становятся снятыми, потому что вы визуализируете и повторно визуализируете их вместе с output$panel . Вы забыли добавить uiOutput("checkboxes") в пользовательский интерфейс. Вот шаги:

  1. Удалить tableOutput("checkboxes") из output$panel <- renderUI() .
  2. Добавьте uiOutput("checkboxes"), в пользовательский интерфейс.
  3. Раскомментируйте свою строку if(isTruthy(input2() ... .

Это должно сработать.

Некоторые замечания по поводу кодекса. Я нахожу это излишне сложным. Например, вы используете c(x) в userInput функции, которая не нужна. Вы заключаете input$input1 в реактивное выражение, которое ничего не добавляет (возможно, кроме удобочитаемости), но усложняет цепочку реактивности. Существует несколько способов упростить понимание и чтение кода, что, вероятно, поможет избежать простых ошибок, таких как пропущенный uiOutput .

Комментарии:

1. Спасибо, Ян. Я также включил ваши предложения по упрощению. Я довольно новичок в этом, поэтому мой код быстро становится неуклюжим, когда я спотыкаюсь. Мне особенно трудно пришлось с цепями реактивности. Я открыт для любых других предложений по улучшению! Хотя я однажды отправил запрос на упрощение кода, и реакция сообщества была, мягко говоря, не слишком приветливой.