在R6类中包装闪亮的模块

Question

我目前正在R6课程中包装闪亮的模块,并希望听到有关此设计的一些意见.

基本上,我对一个干净的方法(可读代码)感兴趣,并希望类允许嵌套(请参阅此处的嵌套模块部分).当前的代码符合这两个标准,但我对实现的细节有一些疑问(参见下面的"问题").

上下文

我正在编写多态模块,并认为R6是继承模块之间某些行为的好方法.创建的对象跨会话共享数据(未包含在下面的示例中),因此我构建了它们global.R.

班级代码

MyModule <- R6Class(
  public = list(
    initialize = function(id = shiny:::createUniqueId()){
      private$id <- id
    },
    bind = function(){
      callModule(private$module_server, private$id)
    },
    ui = function(ns = NS(NULL)){
      ns <- NS(ns(private$id))
      fluidPage(
        textInput(ns("text_in"), "text", "enter some text"),
        textOutput(ns("text_out"))
      )
    }
  ),
  private = list(
    id = NULL,
    module_server = function(input, output, session){
      ns <- session$ns
      output$text_out <- renderText({
        input$text_in
      })
    }
  )
)

用法简单

myObj <- MyModule$new()

shinyApp(
  myObj$ui(),
  function(input, output, session){ myObj$bind() }
)

嵌套

some_other_module <- function(input, output, session, obj){
  obj$bind()
  ns <- session$ns
  output$obj_ui <- renderUI({
    obj$ui(ns)
  })
}

some_other_moduleUI <- function(id){
  ns <- NS(id)
  uiOutput(ns("obj_ui"))
}

shinyApp(
  some_other_moduleUI("some_id"),
  function(input, output, session){
    callModule(some_other_module, "some_id", myObj)
  }
)

问题

1. 以前有人做过类似的事吗？如果是这样,我的方法的主要区别在哪里？
2. 使用安全shiny:::createUniqueId()吗？如果没有,base包装中是否有类似的功能？我真的想限制我正在开发的包的依赖性.
3. 我被警告过callModule因为嵌套而使用包装器.任何人都可以展示这种方法失败的用途/案例吗？
4. 使用静态函数(而不是成员函数)构建ui代码会更好吗？

提前感谢您对此主题的任何意见!

Answer 1

我是 R6 和 OOP 的初学者。

这是我在两个面板中调用 R6 模块的经典 Shiny 代码中完成的表示。

它的灵感来自：

• 2019 年 3 月 25 日，zhuchcn.github.io：使用闪亮模块和 R6 类模块化你的闪亮应用程序，由 Chenghao Zhu 编写，但在他的例子中，代码是 100% OOP，即也在 ui et 服务器中。就我而言，它是为了在我的项目中以经典的 Shiny 代码重用。

• 2018 年 7 月 20 日，tbradley1013.github.io：在 R Shiny 模块中使用全局输入值reactive(myreactive())，由 Tyler Bradley 编写，他在其中进行了在模块调用中使用的演示。

对于最后两个问题：

• 3：我认为至少在我的示例中，嵌套模块不存在问题。如果我理解了这个问题。
• 4：我一开始就在UI端寻找静态函数，因为在服务器端实例化太晚了。但除了我的 UI R6 类的根（可能是静态的或不在 R6 中）之外，我的所有 UI R6 实际上都在服务器端。

更新代码：observeEvent(..[R6 module called]..., once=TRUE)添加，修复错误，textInput()删除隐藏

查看https://github.com/philibe/RShinyR6POC了解源代码详细信息。

2023年7月6日编辑，对于模块中调用的R6子模块，也可以在第一级调用的模块中工作：

  initialize = function(){
    ..
    self$ns = NS(session$ns(id)) # was self$ns = NS(id)

NS(session$ns(id))受到SO的启发：在模块服务器功能中访问闪亮的模块ID

代码摘要

模块_R6_Examples.R

#  called in UI
FicheTabGraphUI = R6Class(
  "FicheTabGraphUI",
  public = list(
    FicheTabGraphUI_UI= function (prefixe){
      ns<-NS(prefixe)
      tagList(
        uiOutput(ns("FicheTabGraphUI_UI"))
      )
    }
  )
)

#  called in SERVER
FicheTabGraph = R6Class(
  "FicheTabGraph",
  public = list(
    id = NULL,
    ns =NULL,
    ListeTitres=NULL,
    ListeIdGraphs=NULL,
    DetailsTableIn=NULL,
    RapportCourant.react=NULL,
    DetailsTableInFormatOutput.Fct=NULL ,
    # initializer
    initialize = function(input,output, session,id,ListeTitres,ListeIdGraphs,DetailsTableIn,
                          DetailsTableInFormatOutput.Fct =NULL){
      self$id = id
      self$ns = NS(session$ns(id)) # for sub module of module
      self$SetListeTitres(ListeTitres)
      self$SetListeIdGraphs(ListeIdGraphs)
      self$DetailsTableInFormatOutput.Fct=function (mydatatable) {DT::datatable( mydatatable)}
      callModule(private$FicheTabGraphSERVER,self$id )
      private$server(input, output, session, DetailsTableIn,DetailsTableInFormatOutput.Fct)
    },
    SetListeTitres=function (ListeTitres){
      self$ListeTitres= ListeTitres
    },
    SetListeIdGraphs=function (ListeIdGraphs){
      self$ListeIdGraphs= ListeIdGraphs
    },
    FicheTabGraph_renderUI= function (ListeTitres=self$ListeTitres){

      tagList(
        fluidRow(
          h4(ListeTitres[[1]]),
          column (12,
                  div(
                    DT::dataTableOutput(self$ns("FichePrixTableUI")),
                    class="data_table_output"
                  )
          )
        ),
        fluidRow(
          h4(ListeTitres[[2]]),

          column (12,
                  div(
                    self$FichePrixPlotUI_UI()
                  )
          )
        )
      )
    },
    FichePrixPlotUI_UI = function(ListeIdGraphs= self$ListeIdGraphs){
      divGraphs <- div()
      for (num in 1:length(ListeIdGraphs))  {
        divGraphs <- tagAppendChild(divGraphs, column (6,plotOutput(self$ns(ListeIdGraphs[[num]]))))
      }
      tagList(
        divGraphs
      )
    }
  ),

  private = list(
    SetDetailsTableIn = function(DetailsTableIn ) {
      self$DetailsTableIn<-DetailsTableIn
    },
    DetailsTableSERVER = function(input, output, session ) {

      output$FichePrixTableUI <- DT::renderDataTable(self$DetailsTableInFormatOutput.Fct(self$DetailsTableIn())
      )
    },
    SetDetailsTableInFormatOutput.Fct= function(DetailsTableInFormatOutput.Fct=NULL ) {
      if (!is.null(DetailsTableInFormatOutput.Fct)) {
        self$DetailsTableInFormatOutput.Fct<-DetailsTableInFormatOutput.Fct

      }
    },

    FicheTabGraphSERVER = function(input, output, session) {
      output$FicheTabGraphUI_UI<- renderUI(self$FicheTabGraph_renderUI(  ))
    },
    server= function(input, output, session, DetailsTableIn,
                     DetailsTableInFormatOutput.Fct =NULL){
      private$SetDetailsTableIn(DetailsTableIn)
      private$SetDetailsTableInFormatOutput.Fct(DetailsTableInFormatOutput.Fct)
      callModule(private$DetailsTableSERVER, self$id )

    }
  )
)


#  called in SERVER
FicheGraph = R6Class(
  "FicheGraph",
  public = list(
    id = NULL,
    ns =NULL,
    DetailsTableIn=NULL,

    # initializer
    initialize = function(input,output, session,id,DetailsTableIn,
                          RatioTable.Fct,RatioPlot.Fct,cible
    ){
      self$id = id
      self$ns = NS(session$ns(id))

      self$SetDetailsTableIn(DetailsTableIn)
      callModule(private$RatioPlotSERVER, self$id,self$DetailsTableIn, RatioTable.Fct,RatioPlot.Fct,cible )

    },

    SetDetailsTableIn = function(DetailsTableIn ) {
      if (missing(DetailsTableIn)) return(self$DetailsTableIn)
      self$DetailsTableIn<-DetailsTableIn
    },
    server= function(input, output, session,DetailsTableIn=self$DetailsTableIn,
                     RatioTable.Fct,RatioPlot.Fct,cible ) {

      callModule(private$RatioPlotSERVER, self$id,DetailsTableIn, RatioTable.Fct,RatioPlot.Fct,cible )

    }),
  private= list(
    RatioPlotSERVER = function(input, output, session,
                               DetailsTableIn,RatioTable.Fct,RatioPlot.Fct,cible ) {

      output[[cible]] <- renderPlot(RatioPlot.Fct( RatioTable.Fct(DetailsTableIn())))
    }
  )
)

# called in UI
MiniRapportTabDynUI = R6Class(
  "MiniRapportTabDynUI",
  public = list(
    MiniRapportTabDynUI_UI= function (prefixe, tagParamFiltre){
      ns<-NS(prefixe)
      tagList(
        uiOutput(ns("MiniRapportTabDynUI_UI"))
      )
    }
  )
)


# called in SERVER
MiniRapportTabDyn = R6Class(
  "MiniRapportTabDyn",
  public = list(
    id = NULL,
    ns =NULL,
    ConsolidationFormatOutput.Fct=NULL,
    DetailsTable=NULL,
    RapportsList=NULL,
    RapportCourant.react=NULL,
    liste_colonnes_choisies.react=NULL,
    reactValues=NULL,
    # initializer
    initialize = function(input, output, session,id, tagParamFiltre=div()){
      self$id = id
      self$ns = NS(session$ns(id))
      callModule(self$MiniRapportTabDynSERVER, self$id, tagParamFiltre )
      self$ConsolidationFormatOutput.Fct=function (mydatatable) {DT::datatable( mydatatable)}
    },
    MiniRapportTabDyn_renderUI= function (tagParamFiltre=div()){
      tagList(
        fluidRow(

          fluidRow(div(bsCollapsePanel_panneau_masquable.fct("Click on column name (are excluded columns whith calc, qte, num )",
                                                             div(
                                                               p("Click on column name (are excluded columns whith calc, qte, num )"),
                                                               column (12,
                                                                       div(
                                                                         uiOutput(self$ns("ChoixDimRegroupUI"))
                                                                         #, style=""
                                                                       )
                                                               )
                                                             )
          ), style="margin-left: 20px;"))
        ),
        fluidRow(
          column (12,
                  uiOutput(self$ns("ChoixDimRegroupChoisiUI"))
          )
        ),
        tagParamFiltre,
        fluidRow(
          column (12,
                  div(
                    div(uiOutput(self$ns("ChoixRapportUI")),
                        class='label_non_fixe_items_fixes'
                    )
                  )
          ) ,
          column (12,
                  div( DT::dataTableOutput(self$ns("ConsolidationDataTableUI")),
                       class="data_table_output")
          )
        )
      )

    },
    MiniRapportTabDynSERVER = function(input, output, session, tagParamFiltre = div()) {
      output$MiniRapportTabDynUI_UI<- renderUI(self$MiniRapportTabDyn_renderUI(tagParamFiltre  ))
    },
    server= function(input, output, session, MaitreTable_rows_selected,DetailsTable,RapportsList,
                     ConsolidationFormatOutput.Fct = NULL ){
      private$SetDetailsTable(DetailsTable)
      private$SetRapportsList( RapportsList)
      callModule(private$ChoixDimRegroupSERVER, self$id, MaitreTable_rows_selected)
      callModule(private$ChoixRapportSERVER, self$id )
      callModule(private$ChoixDimRegroupChoisiSERVER, self$id )
      private$SetConsolidationFormatOutput.Fct(ConsolidationFormatOutput.Fct)
      callModule(private$ConsolidationDataTableSERVER, self$id )
    }

  ),
  private = list(

    ListeColonnesDuChoixRapports.fct=function (DetailsTable =   self$DetailsTable) {

      list_colonnes=names(DetailsTable()  )
      list_colonnes<-list_colonnes[!grepl("calc|qte|num",list_colonnes)]

      list_colonnes<-list_colonnes[order(list_colonnes)]
      list_colonnes
    },
    RapportCourant.fct=function(input_choix_rapport, ListeRapportsDf=private$ListeRapportsDf()){
      selection<-((ListeRapportsDf
                   # attention le Coalesce est avec un 1, comme rapport 1
                   %>% filter (value==DescTools::Coalesce(input_choix_rapport,1))
                   %>% select (choix_dim_regroup)
      )[[1]]
      )
      selection <- str_split(selection,",")[[1]]
      selection

    },


    checkboxGroupInput_renderUI= function (input_maitre_rows_selected,
                                           ListeColonnesDuChoixRapports=private$ListeColonnesDuChoixRapports.fct(),
                                           ElementsCoches = self$liste_colonnes_choisies.react()

    )
    {
      #print(input_maitre_rows_selected)
      if (DescTools::Coalesce(input_maitre_rows_selected,0)!=0) {
        checkboxGroupInput(self$ns("ChoixDimRegroup"),
                           label = "",
                           choices  = ListeColonnesDuChoixRapports,
                           inline = TRUE,
                           selected = ElementsCoches
        )

      }else return()
    },
    ChoixDimRegroupSERVER = function(input, output, session,
                                     input_maitre_rows_selected
    ) {
      self$reactValues<-reactiveValues(choix="RapportCourant")
      self$RapportCourant.react<-reactive({
        private$RapportCourant.fct(input$ChoixRapport)
      })
      observeEvent(input$ChoixDimRegroup,
                   self$reactValues$choix<-"ChoixDimRegroup"
      )
      observeEvent(input$ChoixRapport,
                    self$reactValues$choix<-"RapportCourant"
      )
      self$liste_colonnes_choisies.react<-reactive(private$liste_colonnes_choisies.fct(input$ChoixDimRegroup, RapportCourant=self$RapportCourant.react()))
      output$ChoixDimRegroupUI <- renderUI(private$checkboxGroupInput_renderUI(input_maitre_rows_selected()  ))
    },

    ListeRapportsDf=function (RapportsList=self$RapportsList) {

      setNames(
        data.frame(
          t(data.frame(
            RapportsList
          ))
          ,row.names = NULL,stringsAsFactors = FALSE
        ),
        c("value","label","choix_dim_regroup")
      )
    },
    ListeRapportsSetNames=function (ListeRapportsDf= private$ListeRapportsDf()) {


      list_label_value <- ListeRapportsDf

      setNames(list_label_value$value,list_label_value$label)
    },

    selectizeInput_create_renderUI  =function(ListeRapportsSetNames=private$ListeRapportsSetNames()) {
      selectizeInput(self$ns( "ChoixRapport"),
                     label="Report Choice",
                     choices =ListeRapportsSetNames,
                     width = '500px',
                     selected = "1"
                     #  , options = list(render = I(''))
      )
    },
    RapportChoisi_renderUI  =function(list_colonnes) {
      paste(unlist(list_colonnes),collapse=', ')
    },
    liste_colonnes_choisies.fct=function(input_ChoixDimRegroup,
                                         RapportCourant,
                                         Choix =self$reactValues$choix
                                         ) {
      list_colonnes<-switch (Choix,
                        "ChoixDimRegroup"= input_ChoixDimRegroup,
                        "RapportCourant"= RapportCourant,
                        RapportCourant
      )
      list_colonnes
    },
    ConsolidationDataTable_renderDT=function(list_colonnes,
                                             DetailsTable=self$DetailsTable,
                                             ConsolidationFormatOutput.Fct=self$ConsolidationFormatOutput.Fct){
      res<-NULL

      res<-  DetailsTable()

      if (!is.null(res)) {


        res2 <- (res
                 %>% group_by_at(., .vars = (intersect(list_colonnes,colnames(res))))
                 %>% summarise_at(vars(contains("calc", ignore.case = TRUE)),~sum(., na.rm = TRUE))
        )
        res_datas<-res2
      }else {
        res_datas<-data.frame(stringsAsFactors = FALSE)
      }
      ConsolidationFormatOutput.Fct(res_datas)

    },
    ChoixRapportSERVER = function(input, output, session ) {
      output$ChoixRapportUI <- renderUI(private$selectizeInput_create_renderUI())

    },
    ChoixDimRegroupChoisiSERVER = function(input, output, session ) {
      output$ChoixDimRegroupChoisiUI <- renderUI(private$RapportChoisi_renderUI(
        self$liste_colonnes_choisies.react()
      ))
    },
    ConsolidationDataTableSERVER = function(input, output, session ) {
      output$ConsolidationDataTableUI <- DT::renderDataTable(private$ConsolidationDataTable_renderDT(
        self$liste_colonnes_choisies.react()
      ))

    },
    SetDetailsTable = function(DetailsTable ) {
      self$DetailsTable<-DetailsTable
    },
    SetRapportsList = function(RapportsList ) {
      RapportsList<-lapply(RapportsList, function (x,p,r) {
        # To delete spaces from 3rd item
        x[3]<-str_replace_all(x[3],p,r);
        x
      }," ","")
      self$RapportsList<-RapportsList
    },
    SetConsolidationFormatOutput.Fct = function(ConsolidationFormatOutput.Fct=NULL ) {
      if (!is.null(ConsolidationFormatOutput.Fct)) {
        self$ConsolidationFormatOutput.Fct<-ConsolidationFormatOutput.Fct

      }

    }

  )
)

应用程序R

options(encoding = "UTF-8")

library(shiny)
library(shinyjs)
library(shinyBS)
library(dplyr)
library(tidyr)
library(DT)
library(DescTools)
library(R6)
library(ggplot2)
library(ggforce)
library(cowplot)
library(stringr)

source("Modules_R6_Examples.R")
source("Others_Functions.R")


SERVER <- function(input, output, session) {
  
  FakeDatas <- reactive({
    vector_calc<-  c("disp","hp","drat","wt","qsec")
    (mtcars  
      %>% mutate(rowname=rownames(.),
                 TR=ifelse(cyl!=6,"NORM","TR")
      )
      %>% separate(rowname,c("marque","modele"), sep=" ", fill="right", extra="merge")
      %>% rename_at(vars(vector_calc),list(calc=~paste0(.,"_calc")) )
      %>% select (marque, modele,everything())
      %>% select_at(vars(-contains("calc"),contains("calc"))) 
    )
  }
  
  )
  
  
  DetailsTable <-  reactive({
    
    input_appelant=  input$MaitreTable_rows_selected
    validate(
      need(!is.null(input_appelant) , "select a line above (for example : Merc")
    )
    
    res<-  data.frame(stringsAsFactors = FALSE)
    isolate(FakeDatas())%>% filter (marque==isolate(MaitreTable())[as.integer(input_appelant), ])
    
  })
  
   
   consolidationDatas <- reactive({
    
     res<-DetailsTable()
   
     if ( DescTools::Coalesce(input$CheckbFilter,FALSE)==FALSE) {
   
       res<-(res  %>% filter (is.na(TR) | TR=="NORM")
       )
     }
   
     if (nrow(res)>0)  {
        return(res)
      } else {
        return( res [FALSE,])
      }
   
   })
  
   
  
   DetailsTable_filled<-reactive ({
    
     if (
       DescTools::Coalesce(nrow(DetailsTable()),0)>0
     ) TRUE else NULL
  })
  

  
  observeEvent(DetailsTable_filled(),
                                         {
                                             FirstExample<-MiniRapportTabDyn$new(input, output, session,"FirstExample",
                                                                                 div(
                                                                                   fluidRow(
                                                                                     column (3,
                                                                                             div(
                                                                                               p(checkboxInput("CheckbFilter",
                                                                                                                "checked: take the TR",
                                                                                                                FALSE,
                                                                                                                width="100%"
                                                                                                ))
                                                                                             )
                                                                                     )
                                                                                   )
                                                                                 )

                                             )
                                             FirstExample$server(input, output, session,
                                                                 reactive(input$MaitreTable_rows_selected),
                                                                 reactive(consolidationDatas()) ,
                                                                 list( c(1,"basic report (marque)","marque"),
                                                                       c(2,"other report (marque,model)","marque,modele")),
                                                                 Global.detail.synthese.table.output.fct
                                             )
                                         }
                                         ,ignoreNULL = TRUE  ,once=TRUE
  )
  
  observeEvent(input$tabs,
               {
                 if (input$tabs=="2") {
                   FicheTabGraph$new(input, output, session,"SecondExample",
                                     list("datas","graphs"),
                                     list("RatioPlotUI","RepartitionCoutPlotUI"),
                                     reactive(DonneesPie()),
                                     DetailsTableInFormatOutput.Fct=Global.Fiche.output.fct
                   )
                   FicheGraph1<-FicheGraph$new(input, output, session,"SecondExample",reactive(DonneesPie()),
                                               pie_plot_table.fct,
                                               pie_plot_plot.fct,
                                               cible="RatioPlotUI"
                   )
                   FicheGraph1
                   FicheGraph2<-FicheGraph1$clone(deep=TRUE)
                   FicheGraph2$server(input, output, session,
                                      RatioTable.Fct=pie_plot_table.fct,
                                      RatioPlot.Fct=pie_doubleplot_plot.fct,