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

问题描述

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

本质上,用户可以在外部UI中单击一个操作按钮,从而导致通过内部UI模块(可以多次创建)将一堆UI输入插入到UI中

但是,我希望内部模块中创建的四个输入中的两个对其他两个响应,因此对内部服务器代码起作用。但是,尽管是相同的名称空间,但内部模块中的observeEvent似乎并未触发



#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 
                           
             ),pickerInput(  inputId=ns("debitLevelSelector"),label = "Select Level",choices= colnames(data),multiple = FALSE
             )
             
      ),column(4,pickerInput(  inputId=ns("creditValues"),label = "Select credit side",choices=NULL,multiple = TRUE,options = pickerOptions(
                             actionsBox = TRUE,selectedtextformat = "count",liveSearch = TRUE
                           )
             ),pickerInput(  inputId=ns("debitValues"),label = "Select debit side",liveSearch = TRUE
                           )
             )
             
      ),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,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",data)
         
         
         
     }
     
    
)
        


  }

)
}





如果有助于输入,则内部服务器中的$ creditLevelSelector会变为NULL。

但是它应该是数据的别名,因为它是显示内容

解决方法

我设法使其正常工作。插入UI时,您必须将ID包装在名称空间中,而不是将内部服务器包装

库(“发光”) 库(“ shinyWidgets”)

#UI元素 externalUI

ns <- NS(id)

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

}

##### sever代码内部用户界面

innerUiTemplate

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,multiple = FALSE
    )
    
)

}

#updates innerServer

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

}

###########服务器代码-外部用户界面

outerServer

        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

主服务器

服务器

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

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

}

# run app
shinyApp(ui,server)