Question

我正在尝试泛化Shiny模块，以便可以传递不同的功能，但是预期的反应性行不通-有人可以向我指出正确的方向吗？下面有一个reprex说明了我的问题。

我希望可以动态选择view_id来更改renderShiny（）函数中的值。它适用于应用程序加载，但更改选择不会通过。

与在其中创建模块功能的环境有关吗？

library(shiny)

create_shiny_module_funcs <- function(data_f,
                                      model_f,
                                      outputShiny,
                                      renderShiny){

  server_func <- function(input, output, session, view_id, ...){

    gadata <- shiny::reactive({
      # BUG: this view_id is not reactive but I want it to be
      data_f(view_id(), ...)
    })

    model_output <- shiny::reactive({
      shiny::validate(shiny::need(gadata(),
                                  message = "Waiting for data"))
      model_f(gadata(), ...)
    })

    output$ui_out <- renderShiny({
      shiny::validate(shiny::need(model_output(),
                                  message = "Waiting for model output"))
      message("Rendering model output")
      model_output()
    }, ...)

    return(model_output)
  }

  ui_func <- function(id, ...){
    ns <- shiny::NS(id)
    outputShiny(outputId = ns("ui_out"), ...)
  }

  list(
    shiny_module = list(
      server = server_func,
      ui = ui_func
    )
  )

}

# create the shiny module
ff <- create_shiny_module_funcs(
  data_f = function(view_id) mtcars[, view_id],
  model_f = function(x) mean(x),
  outputShiny = shiny::textOutput,
  renderShiny = function(x) shiny::renderText(paste("Mean is: ", x))
)

## ui.R
ui <- fluidPage(title = "module bug Shiny Demo",

                h1("Debugging"),
                selectInput("select", label = "Select", choices = c("mpg","cyl","disp")),
                textOutput("view_id"),
                ff$shiny_module$ui("demo1"),
                br()
)

## server.R
server <- function(input, output, session){

  view_id <- reactive({
    req(input$select)
    input$select
  })

  callModule(ff$shiny_module$server, "demo1", view_id = view_id)

  output$view_id <- renderText(paste("Selected: ", input$select))

}

# run the app
shinyApp(ui, server)

Answer 1

问题是renderShiny函数需要包装另一个创建实际输出的函数，因此我实际上混淆了它的两个独立功能：renderShiny应该接受另一个实际输出的函数创建要渲染的东西。然后，下面的作品：

library(shiny)

module_factory <- function(data_f = function(x) mtcars[, x],
                           model_f = function(x) mean(x),
                           output_shiny = shiny::plotOutput,
                           render_shiny = shiny::renderPlot,
                           render_shiny_input = function(x) plot(x),
                           ...){

  ui <- function(id, ...){
    ns <- NS(id)
    output_shiny(ns("ui_out"), ...)
  }

  server <- function(input, output, session, view_id){

    gadata <- shiny::reactive({

      data_f(view_id(), ...)

      })

    model <- shiny::reactive({
      shiny::validate(shiny::need(gadata(),
                                  message = "Waiting for data"))
      model_f(gadata(), ...)
    })

    output$ui_out <- render_shiny({
      shiny::validate(shiny::need(model(),
                                  message = "Waiting for model output"))
      render_shiny_input(gadata())
    })

    return(model)
  }

  list(
    module = list(
      ui = ui,
      server = server
    )
  )
}

made_module <- module_factory()

## ui.R
ui <- fluidPage(title = "module bug Shiny Demo",

                h1("Debugging"),
                selectInput("select", label = "Select", choices = c("mpg","cyl","disp")),
                textOutput("view_id"),
                made_module$module$ui("factory1"),
                br()
)

## server.R
server <- function(input, output, session){

  callModule(made_module$module$server, "factory1", view_id = reactive(input$select))
  output$view_id <- renderText(paste("Selected: ", input$select))

}

# run the app
shinyApp(ui, server)

Answer 2

我想你想要这样的东西。

<p *ngIf="fechaInicio">{{ fechaInicio.toDate() | date }}</p>

数据源：

https://gist.githubusercontent.com/seankross/a412dfbd88b3db70b74b/raw/5f23f993cd87c283ce766e7ac6b329ee7cc2e1d1/mtcars.csv

通过函数创建模块时使Shiny模块具有反应性

2 个答案: