时间戳

首页 > 解决方案 > 获取内部模块服务器以更新 innerServerUI - Rshiny Modules

r - 获取内部模块服务器以更新 innerServerUI - Rshiny Modules

问题描述

这是我第一次使用 Shiny Modules，但在让内部服务器模块正常工作时遇到了一些问题。

本质上，在外部 UI 中，用户可以单击一个操作按钮，这会导致一堆 UI 输入通过内部 UI 模块插入到 UI 中（可以多次创建）

但是，我希望内部模块中创建的四个输入中的两个对其他两个具有反应性，因此是内部服务器代码。然而，尽管是相同的命名空间，内部模块中的 observeEvents 似乎并没有触发



#UI elements
specificTransactionOuterUI<-function(id,data){
  useShinyjs()

  ns <- NS(id)
  
  tagList(
  actionButton(inputId=ns("createSpecificFlow"), "Add New Specific Transaction Column"),

  uiOutput(ns("specificTransactionUI"))
  )
}




#####sever code inner UI

specificTransactionInnerUiTemplate<-function(id, data){
  useShinyjs()
  ns=NS(id)
  
  div(id =ns("specifcTransactionInnerUiDiv"),
  
    fluidRow(
      
      column(4,
             
             
             
             textInput("newColSpecificTransaction", "Give new column a name", value = ""),
             br(),
             
             pickerInput(  inputId=ns("creditLevelSelector"),
                           label = "Select level",
                           choices=colnames(data),
                           selected = NULL,
                           multiple = FALSE 
                           
             ),
             br(),
             
             pickerInput(  inputId=ns("debitLevelSelector"),
                           label = "Select Level",
                           choices= colnames(data),
                           selected = NULL,
                           multiple = FALSE
             )
             
      ),
      
      
      column(4,
             br(),
             br(),br(),
             br(),
             pickerInput(  inputId=ns("creditValues"),
                           label = "Select credit side",
                           choices=NULL,
                           selected = NULL,
                           multiple = TRUE,
                           options = pickerOptions(
                             actionsBox = TRUE, 
                             selectedTextFormat = "count", 
                             liveSearch = TRUE
                           )
             ),
             
             br(),
             
             pickerInput(  inputId=ns("debitValues"),
                           label = "Select debit side",
                           choices=NULL,
                           selected = NULL,
                           multiple = TRUE,
                           options = pickerOptions(
                             actionsBox = TRUE, 
                             selectedTextFormat = "count", 
                             liveSearch = TRUE
                           )
             )
             
      ),
      
      
      
      column(4,
             br(),br(),
             br(),br(),br(),br(),
             actionButton( inputId=ns("RemoveSpecificTransaction"), "Remove Specific Flow Column")
             
      )
      
    )
  
  
  
  )
  }
  
#updates
specificTransactionInnerServer<-function(id,data){
  moduleServer(
    id,
    function(input, output, session) {


      ns <- session$ns
  #

observeEvent(input$creditLevelSelector,{
  


  updatePickerInput(
    session,
    inputId="creditValues",
   choices = unique(data[[input$creditLevelSelector]])

     )
})

#updateValuesDebits

observeEvent(input$debitLevelSelector,{


  updatePickerInput(
    session,
    inputId="debitValues",
    choices = unique(data[[input$debitLevelSelector]])

  )


})

# ###remove button server side

observeEvent(input$RemoveSpecificTransaction, {

  removeUI(selector =paste0("#", ns("specifcTransactionInnerUiDiv")))
  remove_shiny_inputs(id, input)
  # session$specificFlow$removeFlow$destroy()
  # session$specificFlow$debitLevel$destroy()
  # session$specificFlow$creditLevel$destroy()
})



    }
)
}
  




##########server code - outer UI

specificTransactionOuterServer<-  function(id,data){
  moduleServer(
    id,
  function(input, output, session) {
 
    
     counter<-reactiveValues()

     counter$count=0
     
     ns <-session$ns
     
     
    
    
     observeEvent(input$createSpecificFlow, {
         
         counter$count=counter$count+1
        insertUI(selector=paste0("#",ns("specificTransactionUI")),where="afterEnd", specificTransactionInnerUiTemplate(id=paste0("specificFlow", counter$count ), data) )
        specificTransactionInnerServer(id=paste0("specificFlow", counter$count ), data)
         
         
         
     }
     
    
)
        


  }

)
}

如果它有助于 input$creditLevelSelector 在内部服务器中评估为 NULL。

但是它应该是数据的名称，因为这就是它显示的内容。

标签： rshinyshinymodules

解决方案

我已经设法让它工作了。插入 UI 时，您必须将 id 包装在命名空间中，但不是 innerServer

库（“闪亮”） 库（“闪亮小部件”）

#UI 元素 outerUI<-function(id){

ns <- NS(id)

tagList(
    actionButton(inputId=ns("addItem"), "Add New Item"),
    div(id = ns('innerModulePlaceholder'))
)

}

#####服务器代码内部用户界面

innerUiTemplate<-function(id, data){

ns=NS(id)




fluidRow(
    
    
    
    
    pickerInput(  inputId=ns("columnSelector"),
                  label = "Select Column",
                  choices=colnames(data),
                  selected = NULL,
                  multiple = FALSE 
                  
    ),
    br(),
    
    pickerInput(  inputId=ns("ValueSelector"),
                  label = "Select Values",
                  choices= NULL,
                  selected = NULL,
                  multiple = FALSE
    )
    
)

}

#updates innerServer<-function(id,data){ moduleServer(id, function(input, output, session) {

        ns <-session$ns
        
        
        observeEvent(input$columnSelector,{
            
            print(input$columnSelector)
            
            updatePickerInput(
                session,
                inputId="ValueSelector",
                choices = input$columnSelector
                
            )
        })
        
        
        
    }
)

}

##########服务器代码 - 外部 UI

outerServer<- function(id,data){ moduleServer(id, function(input, output, session) {

        counter<-reactiveValues()
        
        counter$count=0
        
        ns <-session$ns
        
        
        
        
        observeEvent(input$addItem, {
            print("boo")
            counter$count=counter$count+1
            insertUI(selector=paste0("#",ns("innerModulePlaceholder")),where="afterEnd", innerUiTemplate(id=ns(paste0("innerModule", counter$count )), data) )
            innerServer(id=paste0("innerModule", counter$count ), data )
            
            
            
        }
        
        
        )
        
        
        
    }
    
)

}

#mainUI

ui <-流体页面（uiOutput（“模块”））

主服务器

服务器 <- 功能（输入，输出，会话）{

data<-reactive({
    
    column1<-c(1,2,3,4,5)
    column2<-c(5,6,7,4,2)
    data<-data.frame(column1, column2)
    
    return(data)
})

output$Module <-renderUI({
    outerUI(id="firstTime" ) 
    
})
outerServer(id="firstTime", data() )

}

# run app
shinyApp(ui, server)

推荐阅读