我是 R6 和 OOP 的初学者。
这是我在两个面板中调用 R6 模块的经典 Shiny 代码中完成的一个表示。
它的灵感来自：
对于最后两个问题：
- 3：我认为嵌套模块没有问题，至少在我的例子中。如果我理解了这个问题。
- 4：我一开始就在寻找UI端的静态函数，因为在服务器端实例化太晚了。但除了我的 UI R6 类的根，它可能是静态的或不在 R6 中，我所有的 UI R6 实际上都在服务器端。
代码更新：observeEvent(..[R6 module called]..., once=TRUE)添加，错误修复，隐藏textInput()删除
查看https://github.com/philibe/RShinyR6POC以获取源代码详细信息。
代码摘要
Modules_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(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,
liste_colonnes_choisies.react=NULL,
reactValues=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(),
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,
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")
}