r - 模块内模块闪亮

问题描述

我正在尝试从模块内部调用模块并遇到一些问题。

第一个代码正在运行，它显示了一个带有创建弹出窗口的按钮的应用程序。弹出窗口内是一个绘图和一个滑块输入。弹出图在它自己的模块中定义。

library(shiny)
library(shinyWidgets)

uiForModal <<- function(id) {
  ns <- NS(id)
    tagList(
        fluidRow(
            plotOutput(outputId = ns("plot")),
            sliderInput(
                inputId =ns( "clusters"),
                label = "Number of clusters",
                min = 2, max = 6, value = 3, width = "100%"
            )
        )
    )   
}

serverForModal <<- function(input, output, session) {
    output$plot <- renderPlot({
        print(head(iris))
        plot(Sepal.Width ~ Sepal.Length,
            data = iris, col = Species,
            pch = 20, cex = 2)
        points(kmeans(iris[, 1:2], input$clusters)$centers,
            pch = 4, cex = 4, lwd = 4)
    })
}

ui <- fluidPage(
  actionButton("showPlot", "showPlot")
)

server <- function(input, output){
    observeEvent(input$showPlot, {
        show_alert(
            title = "Some Title",
            text = tags$div(
                uiForModal("test1")
            ),
            html = TRUE,
            width = "80%"
        )
    })
    callModule(serverForModal, "test1")
}
runApp(shinyApp(ui, server))

当我尝试将按钮放在它自己的模块中时，就会出现问题。下面的代码是我失败的尝试。我认为问题与命名空间有关。在下面的代码中，按钮使用弹出窗口和滑块调用 UI，但绘图不显示。所以我认为问题出在情节的服务器命名空间中。有人可以帮我吗？


library(shiny)
library(shinyWidgets)

uiForModal <<- function(id) {
    print(id)
    ns <- NS(id)
    print(ns("plot"))
    tagList(
        fluidRow(
            plotOutput(outputId = ns("plot")),
            sliderInput(
                inputId =ns( "clusters"),
                label = "Number of clusters",
                min = 2, max = 6, value = 3, width = "100%"
            )
        )
    )   
}

serverForModal <<- function(input, output, session) {
    output$plot <- renderPlot({
        print(head(iris))
        plot(Sepal.Width ~ Sepal.Length,
            data = iris, col = Species,
            pch = 20, cex = 2)
        points(kmeans(iris[, 1:2], input$clusters)$centers,
            pch = 4, cex = 4, lwd = 4)
    })
}

uiForButton <<- function(id) {
    ns <- NS(id)
    tagList(
        fluidRow(
            actionButton(ns("showPlot"), "showPlot")
        )
    )
}

serverForButton <<- function(input, output, session, ns) {
    observeEvent(input$showPlot, {
        show_alert(
            title = "Some Title",
            text = tags$div(
                uiForModal(ns("test2"))
            ),
            html = TRUE,
            width = "80%"
        )
    })
    callModule(serverForModal, ns("test2"))
}

ui <- fluidPage(
    uiForButton("test1")
)
server <- function(input, output){
    callModule(serverForButton, "test1", NS("test1"))
}
    
runApp(shinyApp(ui, server))

标签： rshiny

r - 模块内模块闪亮

问题描述

解决方案

推荐阅读