Блог

Ниже МВт код работает как задумано, за исключением того, что я хотел бы, нажав кнопку «Сброс» кнопка действия в модальное диалоговое окно, чтобы вызвать матрицы входных сетки внутри модального диалога мгновенно (реактивно) сброс к значениям по умолчанию (объект matrix3Default ) и оказанные таблицы в основной панели также мгновенно (реактивно) сброс к значениям по умолчанию (объект matrix3Default ).

В готовом виде после нажатия кнопки «Сброс» входная сетка матрицы и отрисованная таблица на главной панели отображаются повторно только после того, как пользователь нажмет кнопку действия «Изменить…» на боковой панели.

Как мне сделать кнопку «Сброс» немедленно реагирующей, когда пользователь нажимает на кнопку «Сброс»?

Моя неудачная попытка сделать это указана ниже в разделе «НИЖЕ ПОПЫТКА…».

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

Код MWE:

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

colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))

matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL))

matrix3Headers <- function(){c('A','B','C','D')}

matrix3Input <- function(x, matrix3Default){
  matrixInput(x,label='Input series terms into below grid:',value=matrix3Default, 
              rows= list(extend=FALSE,names=TRUE),cols= list(extend=TRUE,names=TRUE,
                    editableNames=FALSE,delete=TRUE),class='numeric')}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")))), 
      uiOutput("Panels") 
    ), # close sidebar panel
    
    mainPanel(
      tabsetPanel(
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(actionButton('showLiabStructBtn','Liabilities')),
                 div(style = "margin-top: 5px"),
                 uiOutput('showResults')), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  showResults <- reactiveValues()
  rv          <- reactiveValues( 
    mat3      =  matrix3Input('matrix3',matrix3Default),
    input     =  matrix3Default,
    colHeader =  colnames(input))
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('modLiabStruct','Modify Liabilities Structure'))
    ) # close tagList
  }) # close renderUI
  
  vectorLiabStruct <- reactive({
    if(!isTruthy(input$modLiabStruct)){ 
      df <- matrix3Default
      df
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
    }
    else{ 
      req(input$matrix3) 
      rv$mat3 <- matrix3Input('matrix3',input$matrix3) 
      df <- input$matrix3
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
      rv$input <- df
    } # close else
    df})
  
  output$table3 <- renderTable({
    if(!isTruthy(input$modLiabStruct)){ 
      df <- matrix3Default
      df
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
    }
    else{ 
      req(input$matrix3) 
      rv$mat3 <- matrix3Input('matrix3',input$matrix3) 
      df <- input$matrix3
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
      rv$input <- df
    } # close else
    df},rownames=TRUE, colnames=TRUE)
  
  observeEvent(input$modLiabStruct,{ 
    showModal(modalDialog( 
      rv$mat3,
      footer = tagList(
        actionButton("resetLiabStruct","Reset"), 
        modalButton("Close")
      ), # close tag list
    )) # close show modal and modal dialog
  }) # close observe event
  
  observeEvent(input$showLiabStructBtn,{showResults$showme<-tagList(tableOutput("table3"))},ignoreNULL=FALSE)  
  
  # BELOW ATTEMPT...
  observeEvent(input$resetLiabStruct,{
    rv$input <- matrix3Default
    rv$mat3  <- matrix3Input('matrix3',matrix3Default)
    {showResults$showme <- tagList(tableOutput("table3"))}
  },ignoreNULL = TRUE) # close observe event

  output$showResults <- renderUI({showResults$showme})
}) # close server

shinyApp(ui, server)
 

Вы получаете такое поведение, потому что после загрузки вашим первым observeEvent() ( input$modLiabStruct ), matrix3 показанное в модальном поле не обновляется само по себе.

Поскольку это a matrixInput , вам необходимо обновить его с помощью функции типа updateInput, к счастью, она предоставляется пакетом shinyMatrix. Вы можете изменить свой observeEvent следующим образом:

 observeEvent(input$resetLiabStruct, {
    updateMatrixInput(session, 'matrix3', matrix3Default)
  })