3

すべての UI コードをサーバー関数に移動せずに、モジュール サーバー関数が失敗した場合に、空白の UI を表示する (またはモジュール UI を破棄する) 方法は?

簡単な再現可能な例:

library(shiny)

my_module_ui <- function(id) {
  ns <- NS(id)
  tags$div(
    tags$h1("Don't show me if my_module_server fails!"),
    plotOutput(ns("my_plot"))
  )
}

my_module_server <- function(input, output, session) {

  tryCatch({
    my_data <- cars * "A" # fail for demo
    # my_data <- cars

    output$my_plot <- renderPlot({
      cars2 <- my_data + rnorm(nrow(my_data))
      plot(cars2)
    })
  }, error=function(cond) {
    message("Destroy UI here!")
  })


}

ui <- fluidPage(
  my_module_ui("my_id")
)

server <- function(input, output, session) {
  callModule(my_module_server, "my_id")
}

shinyApp(ui, server)

私の現在の解決策は、uiOutput()inだけを持ちmy_module_ui、サーバー関数で ui 全体をレンダリングすることです。すべてのUIコンポーネントがモジュールサーバー機能内に配置されていると、大きなモジュールが非常に乱雑になるため、これを防ぎたいです。

callModule()さらに、UI を破棄する値を返すことを避け、代わりにサーバー関数内からこれを行うこともできれば幸いです。

ありがとう！

4

2 に答える 2

2

UI を作成する前にセッション オブジェクトに値を割り当て、この値を評価するのはどうですか (サーバー側からrenderUI().

1) UI のレンダリングをサーバー側に移動

renderUI(my_module_ui("my_id"))サーバー側とuiOutput("module")UI 側で使用します。

2）サーバーモジュールが成功したかどうかを検出するには、セッションオブジェクトに値を割り当てます

my_module_server <- function(input, output, session) {
  tryCatch({
     ...
    session$userData$mod_server <- TRUE
  }, error = function(cond) {
    session$userData$mod_server <- NULL
  })
}

3) この値を使用して、モジュール ui の呼び出しを条件付きにします。

  output$module <- renderUI({
    callModule(my_module_server, "my_id")
    if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
  })

再現可能な例:

library(shiny)

my_module_ui <- function(id) {
  ns <- NS(id)
  tags$div(
    tags$h1("Don't show me if my_module_server fails!"),
    plotOutput(ns("my_plot"))
  )
}

my_module_server <- function(input, output, session) {
  tryCatch({
    my_data <- cars * "A" # fail for demo
    # my_data <- cars

    output$my_plot <- renderPlot({
      cars2 <- my_data + rnorm(nrow(my_data))
      plot(cars2)
    })
    session$userData$mod_server <- TRUE
  }, error = function(cond) {
    session$userData$mod_server <- NULL
  })
}

ui <- fluidPage(
  uiOutput("module")
)

server <- function(input, output, session) {
  output$module <- renderUI({
    callModule(my_module_server, "my_id")
    if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
  })
}
shinyApp(ui, server)
于 2019-11-21T00:11:15.130 に答える
1

少しコードを並べ替え、素晴らしいshinyjs パッケージを使用することで、これを行うことができます。

UI がどのように消えるかを確認するために、エラーではなくエラーをシミュレートする入力を追加したことに注意してください。また、すべてがモジュールのサーバー部分で行われます。これがお役に立てば幸いです。コードには、手順を説明するインライン コメントがあります。

library(shiny)
library(shinyjs)

my_module_ui <- function(id) {
  ns <- NS(id)

  tagList(
    # input added to be able to throw errors and see the ui dissapear
    selectInput(
      ns('trigger'), 'Error trigger',
      choices = list('no error' = c(2,1), 'error' = c('A', 'B')),
      selected = 2
    ),
    tags$div(
      # div with id, to select it with shinyjs and hide it if necessary
      id = ns('hideable_div'),
      tags$h1("Don't show me if my_module_server fails!"),
      plotOutput(ns("my_plot"))
    )
  )
}

my_module_server <- function(input, output, session) {

  # get all the things prone to error in a reactive call, that way you capture the final
  # result or a NULL reactive when an error occurs
  foo <- reactive({

    tryCatch({

      if (input$trigger %in% c(2,1)) {
        trigger <- as.numeric(input$trigger)
      } else {
        trigger <- input$trigger
      }

      cars * trigger
    }, error=function(cond) {
      message("Destroy UI here!")
    })
  })

  # obseveEvent based on the error reactive, to check if hide or not the UI
  observeEvent(foo(), {
    # hide checking if foo is null, using shinyjs
    if (is.null(foo())) {
      shinyjs::hide('hideable_div')
    } else {
      shinyjs::show('hideable_div')
    }
  }, ignoreNULL = FALSE, ignoreInit = FALSE)


  # outputs, with validation of the error reactive. That way code after validate is not
  # executed but the app does not get blocked (gray)
  output$my_plot <- renderPlot({
    shiny::validate(
      shiny::need(foo(), 'no data')
    )
    cars2 <- foo() + rnorm(nrow(foo()))
    plot(cars2)
  })

}

ui <- fluidPage(
  # really important for shinyjs tu work!!!!!!!
  shinyjs::useShinyjs(),
  my_module_ui("my_id")
)

server <- function(input, output, session) {
  callModule(my_module_server, "my_id")
}

shinyApp(ui, server)
于 2019-11-18T15:27:52.963 に答える