如何让内部模块使用外部模块的命名空间

问题描述 投票：0回答：1

首先，我定义了

vsmoduleUI
和
vsmoduleServer
，并在
type
的基础上将不同的UI和服务器放入其中。

  • 用户界面
    • vsmoduleUI
      • 酒吧UI
      • 小提琴UI
      • 盒子UI
    • 其他
  • 服务器
    • vsmoduleServer
      • 酒吧服务器
      • 小提琴服务器
      • 盒子服务器
    • 其他

但是，当我执行

go
时，我似乎无法访问输入。
以
barServer
为例，因为
red()
中的
ifesle
为NULL而发生错误。
另一方面，
violinServer
、
boxServer
至少能够绘图，因为我删除了
if else
，但我仍然无法访问输入。

library(shiny)
library(shinyjs)
library(tidyr)
library(ggplot2)


vsmoduleUI <- function(type) {
  ns <- NS(type)
  sidebarLayout(
    sidebarPanel(
      actionButton(ns("go"), "Show control panel, and Generate a reactive plot"),
      shinyjs::hidden(
        div(id = ns("control"),
          get(paste0(type, "UI"))(type)
        )
      )
    ),
    mainPanel(
      plotOutput(ns("plotoutput"))
    )
  )
}

vsmoduleServer <- function(type, userdata, plots) {
  moduleServer(type, function(input, output, session) {

    observeEvent(input$go, {
      df <- userdata  # need some process, maybe it can be delete
      plots[[type]] <- get(paste0(type, "Server"))(type, df)
      shinyjs::show("control")
    })
    output$plotoutput <- renderPlot({
      plots[[type]]()
    })

  })
}

barUI <- function(type) {
  ns <- NS(type)
  tabsetPanel(
    tabPanel("Main",
      sliderInput(ns("width"), label = "bar width", min = 0.1, max = 0.9, value = 0.9),
      checkboxInput(ns("red"), label = "redbar", value = FALSE)
    ),
    tabPanel("test")
  )
}

barServer <- function(type, df) {
  moduleServer(type, function(input, output, session) {

    # in some bioplot, need some processing
    data_processed <- df[1:10, ]

    # contact with inputs
    width <- reactive({input$width})
    red <- reactive({input$red})

    plot <- reactive({

      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg))

      if (red() == FALSE) {
        p <- p + geom_bar(stat = "identity", position = "dodge", width = width())
      } else if (red() == TRUE) {
        p <- p + geom_bar(stat = "identity", position = "dodge", width = width(), aes(fill = "red"))
      }

      return(p)
    })
    return(plot)
  })
}

violinUI <- function(type) {
  ns <- NS(type)
  tabsetPanel(
    tabPanel("Main",
      sliderInput(ns("width"), label = "violin width", min = 0.1, max = 0.9, value = 0.1)
    ),
    tabPanel("test")
  )
}

violinServer <- function(type, df) {
  moduleServer(type, function(input, output, session) {

    # in some bioplot, need some processing
    data_processed <- df

    # contact with inputs
    width <- reactive({input$width})

    plot <- reactive({

      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg, fill = factor(cyl))) +
        geom_violin(width = width())

      return(p)
    })
    return(plot)
  })
}

boxUI <- function(type) {
  ns <- NS(type)
  tabsetPanel(
    tabPanel("Main",
      sliderInput(ns("width"), label = "violin width", min = 0.1, max = 0.9, value = 0.4)
    ),
    tabPanel("test")
  )
}

boxServer <- function(type, df) {
  moduleServer(type, function(input, output, session) {

    # in some bioplot, need some processing
    data_processed <- df

    # contact with inputs
    width <- reactive({input$width})

    plot <- reactive({

      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg, fill = factor(cyl))) +
        geom_boxplot(width = width(), fill = "white", color = "black")

      return(p)
    })
    return(plot)
  })
}

ui <- navbarPage(
  useShinyjs(),
  title = "myhub",
  tabPanel("Visualization",
    tabsetPanel(
      tabPanel("Bar plot", vsmoduleUI("bar")),
      tabPanel("Violin plot", vsmoduleUI("violin")),
      tabPanel("Box plot", vsmoduleUI("box"))
    )
  ),
  tabPanel("A"),
  tabPanel("B"),
  tabPanel("C"),
  tabPanel("More")
)

server <- function(input, output, session) {
  data(mtcars)
  plots <- reactiveValues()
  vsmoduleServer("bar", mtcars, plots)
  vsmoduleServer("violin", mtcars, plots)
  vsmoduleServer("box", mtcars, plots)
}

shinyApp(ui = ui, server = server)

调查结果：

我用了

print(session$ns("nsofbarServer"))
发现命名空间不对，打印的是
bar-bar-nsofbarServer
，又重复了
我认为一种解决方案是在 
ns <- NS(paste0(type, "-", type))
、
ns <- NS(type)
、
barUI
中使用 
violinUI
而不是 
boxUI
。
但我认为它不够优雅或正式。如果有更多精彩的建议，我将不胜感激。

r shiny shinyjs
1个回答
0
投票

您必须添加初始服务器的输入，因为子模块中不知道

input$width
：

  • get(paste0(type, "Server"))(type, df, input0 = input)
  • 东西
    Server <- function(type, df,input0)
  • 在 Athing
    Server()
    中，我将 
    input$width
    替换为 
    input0$width

尝试将

observeEvent(input$width, { browser();input$width})
放入vsmoduleServer / moduleServer和AthingServer / moduleServer之后，你可以看到“
input$width
在子模块中未知”。

这是我的答案，经过一些改进：

  • ifelse(is.null(input0$width),0.4,input0$width)
  • if (isTruthy(plots[[type]]) ) {}

（但是在我写完它之后，我发现我也可以使用待办事项列表向后移植到您的初始源......但没有我的改进。）

library(shiny)
library(shinyjs)
library(tidyr)
library(ggplot2)


widthBarDefault    <- 0.3
widthViolinDefault <- 0.4
widthBoxDefault    <- 0.5

vsmoduleUI <- function(type) {
  
  
  ns <- NS(type)
  
  tagList(
    sidebarLayout(
      sidebarPanel(
        actionButton(ns("go"), "Show control panel, and Generate a reactive plot"),
        shinyjs::hidden(
          div(id = ns("control"),
              # without output$UI <- renderUI(get(paste0(type, "UI"))(type)) in moduleServer()
              get(paste0(type, "UI"))(type),
              
              # or with output$UI <- renderUI(get(paste0(type, "UI"))(type)) in moduleServer()
              # called twice because of reactive() so I let your  get(paste0(type, "UI"))(type) in vsmoduleUI()
              # uiOutput(ns("UI"))              
          )
        )
      ),
      mainPanel(
        plotOutput(ns("plotoutput"))
      )
    )
  )
}

vsmoduleServer <- function(type, userdata, plots) {
  
  
  moduleServer(type, function(input, output, session) {
    
    observeEvent(input$go, {
      df <- userdata  # need some process, maybe it can be delete
      
      plots[[type]] <- get(paste0(type, "Server"))( type, df, input0 = input)
      
      shinyjs::show("control")
      
    })
    
    # With uiOutput(ns("UI")) and without get(paste0(type, "UI"))(type) in vsmoduleUI()
    # call twice because of reactive() so I let your  get(paste0(type, "UI"))(type) in vsmoduleUI()
    # output$UI <- renderUI(get(paste0(type, "UI"))(type))    
    
    
    output$plotoutput <- renderPlot({
      
      
      pp <- NULL
      if (isTruthy(plots[[type]]) ) {
        pp <-plots[[type]]()  
      } 
      pp    
      
    })
    
  })
}

barUI <- function( type) {
  
  
  ns = NS(type)
  
  tagList(
    tabsetPanel(
      tabPanel("Main",
               sliderInput(ns("width"), label = "bar width", min = 0.1, max = 0.9, value = widthBarDefault),
               checkboxInput(ns("red"), label = "redbar", value = FALSE)
      ),
      tabPanel("test")
    )
  )
}



barServer <- function(type, df,input0) {
  moduleServer(type, function(input, output, session) {
    
    
    # in some bioplot, need some processing
    data_processed <- df[1:10, ]
    
    plot <- reactive({
      
      width <- ifelse(is.null(input0$width),widthBarDefault,input0$width)
      red <- ifelse(is.null(input0$red),FALSE,input0$red)
      
      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg))
      
      if (red == FALSE) {
        p <- p + geom_bar(stat = "identity", position = "dodge", width = width)
      } else if (red == TRUE) {
        p <- p + geom_bar(stat = "identity", position = "dodge", width = width, aes(fill = "red"))
      }
      return(p)
    })
    return(plot)
  })
}

violinUI <- function(type) {
  
  ns <- NS(type)
  
  tabsetPanel(
    tabPanel("Main",
             sliderInput(ns("width"), label = "violin width", min = 0.1, max = 0.9, value = widthViolinDefault)
    ),
    tabPanel("test")
  )
}

violinServer <- function(type, df, input0) {
  moduleServer(type, function(input, output, session) {
    
    
    # in some bioplot, need some processing
    data_processed <- df
    
    plot <- reactive({
      
      width <- ifelse(is.null(input0$width),widthViolinDefault,input0$width)
      
      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg, fill = factor(cyl))) +
        geom_violin(width = width)
      
      return(p)
    })
    return(plot)
  })
}

boxUI <- function(type) {
  
  ns <- NS(type)
  
  tabsetPanel(
    tabPanel("Main",
             sliderInput(ns("width"), label = "violin width", min = 0.1, max = 0.9, value = widthBoxDefault)
    ),
    tabPanel("test")
  )
}

boxServer <- function(type, df, input0) {
  moduleServer(type, function(input, output, session) {
    
    # in some bioplot, need some processing
    data_processed <- df
    
    plot <- reactive({
      
      width <- ifelse(is.null(input0$width),widthBoxDefault    ,input0$width)
      
      p <- data_processed %>%
        ggplot(aes(x = factor(cyl), y = mpg, fill = factor(cyl))) +
        geom_boxplot(width = width, fill = "white", color = "black")
      
      return(p)
    })
    return(plot)
  })
}

ui <- navbarPage(
  useShinyjs(),
  title = "myhub",
  tabPanel("Visualization",
           tabsetPanel(
             tabPanel("Bar plot", vsmoduleUI("bar")),
             tabPanel("Violin plot", vsmoduleUI("violin")),
             tabPanel("Box plot", vsmoduleUI("box"))
           )
  ),
  tabPanel("A"),
  tabPanel("B"),
  tabPanel("C"),
  tabPanel("More")
)

server <- function(input, output, session) {
  
  
  data(mtcars)
  plots <- reactiveValues()
  vsmoduleServer("bar", mtcars, plots)
  vsmoduleServer("violin", mtcars, plots)
  vsmoduleServer("box", mtcars, plots)
}

shinyApp(ui = ui, server = server)

这是显示模块的好 ID 和子 ID 的 html。

<div class="tab-content" data-tabsetid="8981">
    <div class="tab-pane active" data-value="Bar plot" id="tab-8981-1">
        <div class="row">
            <div class="col-sm-4">
                <form class="well" role="complementary">
                    <button id="bar-go" type="button" class="btn btn-default action-button">Show control panel, and Generate a reactive plot</button>
                    <div id="bar-control" class="shinyjs-hide">
                        <div id="bar-UI" class="shiny-html-output"></div>
                    </div>
                </form>
            </div>
            <div class="col-sm-8" role="main">
                <div class="shiny-plot-output html-fill-item" id="bar-plotoutput" style="width:100%;height:400px;"></div>
            </div>
        </div>
    </div>
    <div class="tab-pane" data-value="Violin plot" id="tab-8981-2">
        <div class="row">
            <div class="col-sm-4">
                <form class="well" role="complementary">
                    <button id="violin-go" type="button" class="btn btn-default action-button">Show control panel, and Generate a reactive plot</button>
                    <div id="violin-control" class="shinyjs-hide">
                        <div id="violin-UI" class="shiny-html-output"></div>
                    </div>
                </form>
            </div>
            <div class="col-sm-8" role="main">
                <div class="shiny-plot-output html-fill-item" id="violin-plotoutput" style="width:100%;height:400px;"></div>
            </div>
        </div>
    </div>
    <div class="tab-pane" data-value="Box plot" id="tab-8981-3">
        <div class="row">
            <div class="col-sm-4">
                <form class="well" role="complementary">
                    <button id="box-go" type="button" class="btn btn-default action-button">Show control panel, and Generate a reactive plot</button>
                    <div id="box-control" class="shinyjs-hide">
                        <div id="box-UI" class="shiny-html-output"></div>
                    </div>
                </form>
            </div>
            <div class="col-sm-8" role="main">
                <div class="shiny-plot-output html-fill-item" id="box-plotoutput" style="width:100%;height:400px;"></div>
            </div>
        </div>
    </div>
</div>
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.