Обертывание блестящих модулей в классах R6

В настоящее время я оборачиваю блестящие модули в классы 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. Было бы лучше использовать статическую функцию (а не функцию-член) для создания кода пользовательского интерфейса?

Заранее спасибо за любые вклады по этой теме!

Ответ 1

Я новичок в R6 и ООП.

Вот пример, который я сделал в классическом Shiny-коде, вызывающем модули R6 на двух панелях.

Это вдохновлено:

редактировать (читать и применять в начале моего POC, но еще не связано):

/Редактировать

Для двух последних вопросов:

  • 3: я думаю, что нет никакой проблемы о вложенном модуле, в моем примере по крайней мере. Если я понял вопрос.
  • 4: я искал статическую функцию в начале для пользовательского интерфейса из-за того, что реализация на стороне сервера была слишком поздней. Но кроме корня моего пользовательского интерфейса R6, который может быть статическим или нет в R6, все мои пользовательские интерфейсы R6 фактически находятся на стороне сервера.

edit2:

обновлен код: observeEvent(..[R6 module called]..., once=TRUE) добавлено, исправлены ошибки, скрыто textInput() удалено

Modules_R6_Examples.R

#  called in l'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,
    DetailsTableInFormatOutput.Fct=NULL ,

    # initializer
    initialize = function(input,output, session,id,ListeTitres,ListeIdGraphs,DetailsTableIn, 
                          DetailsTableInFormatOutput.Fct =NULL){
      self$id = id
      self$ns = NS(id)
      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(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,

    # initializer
    initialize = function(input, output, session,id, tagParamFiltre=div()){
      self$id = id
      self$ns = 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(),
                                           RapportCourant = self$RapportCourant.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 = RapportCourant
        ) 

      }else return()
    },
    ChoixDimRegroupSERVER = function(input, output, session,
                                     input_maitre_rows_selected
    ) {



      output$ChoixDimRegroupUI <- renderUI(private$checkboxGroupInput_renderUI(input_maitre_rows_selected()  ))
      self$RapportCourant.react<-reactive(private$RapportCourant.fct(input$ChoixRapport))
    },

    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(input_ChoixDimRegroup, RapportCourant=self$RapportCourant.react()) {
      if (is.null(input_ChoixDimRegroup)) {
        list_colonnes<- RapportCourant
      } else {
        list_colonnes<-input_ChoixDimRegroup
      }

      div(
        span("Regroupement choisi : "),
        div(p(paste(unlist(list_colonnes),collapse=', ')), class="gras")
      )

    },
    ConsolidationDataTable_renderDT=function(input_ChoixDimRegroup, 
                                             RapportCourant=self$RapportCourant.react(),
                                             DetailsTable=self$DetailsTable,
                                             ConsolidationFormatOutput.Fct=self$ConsolidationFormatOutput.Fct){
      res<-NULL

      if (is.null(input_ChoixDimRegroup)) {
        list_colonnes<-RapportCourant
      } else {
        list_colonnes<-input_ChoixDimRegroup
      }

      res<-  DetailsTable()

      if (!is.null(res)) {


        res2 <- (res
                 %>% group_by_at(., .vars = list_colonnes)
                 %>% 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(input$ChoixDimRegroup))

    },    
    ConsolidationDataTableSERVER = function(input, output, session ) {
      output$ConsolidationDataTableUI <- DT::renderDataTable(private$ConsolidationDataTable_renderDT(input$ChoixDimRegroup))

    },
    SetDetailsTable = function(DetailsTable ) {
      self$DetailsTable<-DetailsTable
    },  
    SetRapportsList = function(RapportsList ) {
      self$RapportsList<-RapportsList
    }, 
    SetConsolidationFormatOutput.Fct = function(ConsolidationFormatOutput.Fct=NULL ) {
      if (!is.null(ConsolidationFormatOutput.Fct)) {
        self$ConsolidationFormatOutput.Fct<-ConsolidationFormatOutput.Fct      

      }

    }

  )
)

app.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,
                                      cible="RepartitionCoutPlotUI"
                   )
                 }
               }
               ,ignoreInit=TRUE,once=TRUE 
  )
  MaitreTable <-  reactive({

    unique(isolate(FakeDatas()) %>% select(marque)%>% arrange(marque))
  })  


  output$MaitreTable <- DT::renderDataTable(
    DT::datatable( MaitreTable(),
                   style = "bootstrap",   class = "compact", filter='top',
                   selection = c("single"),    
                   options = list(
                     deferRender = TRUE, 
                     bSortClasses = TRUE,iDisplayLength = 3,   width = "100%",
                     scrollX=TRUE,
                     autoWidth = TRUE
                   )
    )   
  )


  output$DetailsTable <- DT::renderDataTable(
    DT::datatable( DetailsTable()      ,
      style = "bootstrap",   class = "compact", filter='top',
      selection = c("single"),    
      options = list(
        deferRender = TRUE, 
        bSortClasses = TRUE,iDisplayLength = 3,   width = "100%",
        scrollX=TRUE,
        autoWidth = TRUE
      )
    )   
  ) 

}

BaseMiniRapportTabDynUI<-MiniRapportTabDynUI$new()
BaseFicheTabGraphUI<-FicheTabGraphUI$new()
largeur_page_pct<-96


UI<-shinyUI(
  fluidPage(
    useShinyjs(),
    tags$style(type = "text/css", HTML(paste0(".data_table_output {font-size:80%;white-space: nowrap;width:",largeur_page_pct,"%;}"))),
    tags$style(type = "text/css", HTML(paste0("
                                    .bsCollapsePanel-petite {width:",largeur_page_pct,"%;
                                              -webkit-transition-delay: 0s;
                                              transition-delay: 0s;
                                              margin-bottom: -20px;
                                              }","
                                              .bsCollapsePanel-petite .panel-body { padding: 0px;}
                                              .bsCollapsePanel-petite .panel-title {font-size:80%;}
                                              .bsCollapsePanel-petite .panel-heading {padding: 0px;}
                                              "))),  
    tabsetPanel(id = "tabs",
                tabPanel("First Example", value="1",
                         h1("First Example"),
                         DT::dataTableOutput('MaitreTable'),
                         fluidRow(
                           h2("select a line above to have mini report below "),p("for example 'Merc'") 
                         ),  
                         fluidRow(
                           BaseMiniRapportTabDynUI$MiniRapportTabDynUI_UI("FirstExample")
                         ),
                         fluidRow(
                           h4("Details"),

                           column (12,
                                   div(DT::dataTableOutput('DetailsTable'), 
                                       class="data_table_output")
                           )
                         )),

                tabPanel("Second Example",value="2",
                         fluidRow(
                           div(
                             BaseFicheTabGraphUI$FicheTabGraphUI_UI("SecondExample"),
                             style="margin-left: 20px;"
                           )
                         )
                )
    )
  ) 
)

shinyApp(UI, SERVER)

Others_Functions.R

formatRound.try.fct <- function(mydatatable, mycolumn, taille) {
  tryCatch({
    return(DT::formatRound(mydatatable, mycolumn, taille))
  }, error = function(cond) {
    print(paste0("Warning: Erreur de nom de colonne (", mycolumn, ") pour formatRound"))
    return(mydatatable)
  })
}



Global.Fiche.output.fct <- function (mydatatable) {
  res<-DT::datatable( mydatatable,
                      style = "bootstrap",   class = "compact", filter='top', 
                      selection = c("none"),
                      options = list(
                        deferRender = TRUE,   bSortClasses = TRUE,iDisplayLength = 30,   width = "100%",
                        scrollX=TRUE,   autoWidth = TRUE
                      )
  )



  return (res)
}


Global.detail.synthese.table.output.fct <- function (mydatatable) {
  res<-DT::datatable( mydatatable,

                      style = "bootstrap",   class = "compact", filter='top', 
                      selection = c("single"),
                      options = list(
                        deferRender = TRUE,   bSortClasses = TRUE,iDisplayLength = 30,   width = "100%",
                        scrollX=TRUE,   autoWidth = TRUE
                      )
  )

  res <- (res
          %>% formatRound.try.fct('disp_calc', 2)
          %>% formatRound.try.fct('hp_calc', 2)
          %>% formatRound.try.fct('drat_calc', 2)
  )

  return (res)
}    


DonneesPie<- reactive(
  data.frame(
    state = c('eaten', 'eaten but said you didn\'t', 'cat took it',
              'for tonight', 'will decompose slowly'),
    focus = c(0.2, 0, 0, 0, 0),
    start = c(0, 1, 2, 3, 4),
    end = c(1, 2, 3, 4, 2*pi),
    amount = c(4,3, 1, 1.5, 6),
    coul=c(1,"aa","aa","bb","bb"),
    stringsAsFactors = FALSE
  )
)

pie_plot_table.fct=function (pie) {
  pie %>%
    mutate(end=2*pi*cumsum(amount)/sum(amount),
           start = lag(end, default = 0),
           middle = 0.5 * (start + end),
           hjust = ifelse(middle > pi, 1, 0),
           vjust = ifelse(middle < pi/2 | middle > 3 * pi/2, 0, 1),
           label=paste(state, paste0(round(((amount/sum(amount))*100),2),"%;",amount,"euros"))
    )
}

pie_plot_plot.fct=function(pie){
  ggplot(pie) +
    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0, r = 1,amount = amount,
                     fill = label,explode = focus),stat = 'pie') +
    ggtitle("Plot of length by dose") +
    labs(fill = "Dose (mg)")+
    geom_text(aes(x = 1.05 * sin(middle), y = 1.05 * cos(middle),
                  label = label, hjust = hjust, vjust = vjust
    )) +
    coord_fixed() +theme_no_axes() +
    scale_x_continuous(limits = c(-2, 2),  name = "", breaks = NULL, labels = NULL) +
    scale_y_continuous(limits = c(-1.5, 1.5),    name = "", breaks = NULL, labels = NULL)


}

pie_doubleplot_plot.fct=function(mydata){

  mydata<-mydata 

  p0<-ggplot(mydata)+ ggtitle("Plot of length by dose") + 
    coord_fixed() +theme_no_axes() +
    scale_x_continuous(limits = c(-2, 2),  # Adjust so labels are not cut off
                       name = "", breaks = NULL, labels = NULL) +
    scale_y_continuous(limits = c(-1.5, 1.5),      # Adjust so labels are not cut off
                       name = "", breaks = NULL, labels = NULL)

  toto<-unlist(list(colorspace::qualitative_hcl(length(mydata$coul),"Dynamic"), 
                    colorspace::qualitative_hcl(length(mydata$label),"Dark 3"))) 


  titi<-setNames(toto,unlist(list(mydata$coul,mydata$label)))

  p1<-p0 +  
    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0.6, r = 1,amount = amount,
                     fill = label,explode = focus),stat = 'pie') + 
    labs(fill = "ratio")  +scale_fill_manual(values =titi) 


  p2<-p0+
    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0, r = 0.5,amount = amount,
                     fill = coul,explode = focus),stat = 'pie',data=mydata) + 
    labs(fill = "produit")+  scale_fill_manual(values =titi)

  ptotal<-p0 +  

    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0, r = 0.5,amount = amount,
                     fill = coul,explode = focus),stat = 'pie',data=mydata) + 
    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0.6, r = 1,amount = amount,
                     fill = label,explode = focus),stat = 'pie',data=mydata) + 
    scale_fill_manual(values = titi)+geom_text(aes(x = 1.05 * sin(middle), y = 1.05 * cos(middle), 
                                                   label = label, hjust = hjust, vjust = vjust
    ))

  plot_grid(ptotal+ theme(legend.position = "none"),
            plot_grid(
              get_legend(p1 + theme(legend.position = "right",plot.margin = unit(c(0,0,0,0), "cm"))),
              NULL,                       
              get_legend(p2 + theme(legend.position = "bottom",plot.margin = unit(c(0,0,0,0), "cm"))),
              rel_heights =  c(1, -0.7, 1), ncol=1
            )
  )
}


bsCollapsePanel_panneau_masquable.fct<- function (titre,contenu) { 
  div(shinyBS::bsCollapsePanel(titre,"",
                               contenu
  ),class="bsCollapsePanel-petite")                   
}