-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
243 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,5 @@ | ||
{ | ||
"parent": "", | ||
"type": "internal", | ||
"title": "" | ||
} |
20 changes: 20 additions & 0 deletions
20
shiny/shiny-calipseo/modules/core/sunburst_chart_i18n_en.json
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,20 @@ | ||
{ | ||
|
||
/*Pretty table keys on the SERVER*/ | ||
"BUCKET_HEADER" : "Drag the items in choosen bucket to display and rank variables as desired", | ||
"AVAILABLE_VARIABLES" : "Unselected variables", | ||
"SELECTED_VARIABLES" : "Selected variables", | ||
|
||
|
||
/*Plot and datatable/export labels*/ | ||
"TOTAL_LABEL" : "Grand Total", | ||
"EMPTY_TABLE_MESSAGE" :"(Please select variables to display statistic table)", | ||
"STATISTIC_TABLE_LANGUAGE" : "//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json", | ||
"STATISTIC_DATA_EXPORT_FILENAME" : "statistics_table", | ||
"STATISTIC_PDF_TITLE" : "Statistics table", | ||
|
||
/*tabpanels*/ | ||
"TABPANEL_STATISTIC" : "Statistics", | ||
"TABPANEL_PLOT" : "Plot" | ||
|
||
} |
172 changes: 172 additions & 0 deletions
172
shiny/shiny-calipseo/modules/core/sunburst_chart_server.R
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,172 @@ | ||
#' @name sunburst_chart_server | ||
#' @aliases sunburst_chart_server | ||
#' @title sunburst_chart_server | ||
#' @description \code{sunburst_chart_server} Server part of sunburst_chart module | ||
#' | ||
#' @usage sunburst_chart_server(id,df,colVariables,colValue,mode) | ||
#' | ||
#' @param id specific id of module to be able to link ui and server part | ||
#' @param df dataframe | ||
#' @param colVariables list of column names available to selection and display | ||
#' @param colValue column name of value | ||
#' @param mode indicate mode to display result, 4 modes available ,'plot','table','plot+table','table+plot' | ||
#' | ||
|
||
sunburst_chart_server <- function(id, df,colVariables=list(),colValue="value",mode="plot") { | ||
moduleServer(id, function(input, output, session) { | ||
ns <- session$ns | ||
|
||
output$select_variable<-renderUI({ | ||
bucket_list( | ||
header = i18n("BUCKET_HEADER"), | ||
group_name = "bucket_list_group", | ||
orientation = "horizontal", | ||
add_rank_list( | ||
text = i18n("AVAILABLE_VARIABLES"), | ||
labels = NULL, | ||
input_id = ns("available_variable") | ||
), | ||
add_rank_list( | ||
text = i18n("SELECTED_VARIABLES"), | ||
labels = colVariables, | ||
input_id = ns("selected_variable") | ||
) | ||
) | ||
}) | ||
|
||
data_formated<-reactiveVal(NULL) | ||
data_for_table<-reactiveVal(NULL) | ||
data_ready<-reactiveVal(FALSE) | ||
|
||
data_formating<-eventReactive(c(input$selected_variable),{ | ||
|
||
df<-df%>% | ||
rename(setNames(colValue,"value")) | ||
|
||
if(!is.null(input$selected_variable)){ | ||
|
||
new_df<-df%>% | ||
select(input$selected_variable,value)%>% | ||
group_by_at(input$selected_variable)%>% | ||
summarise(value=sum(value,na.rm=T))%>% | ||
ungroup() | ||
|
||
data_for_table<-data_for_table(new_df) | ||
|
||
new_df<-new_df%>% | ||
mutate(parent="",root="Total")%>% | ||
relocate(c(parent,root),.before=everything()) | ||
|
||
sb_df<-do.call("rbind",lapply(2:(ncol(new_df)-1), function(i){ | ||
|
||
if(i<=3){ | ||
target_parent<-names(new_df)[i-1] | ||
}else{ | ||
target_parent<-names(new_df)[(2):(i-1)] | ||
} | ||
|
||
target_label<-names(new_df)[i] | ||
target_cols<-names(new_df)[1:i] | ||
target_cols2<-names(new_df)[2:i] | ||
|
||
|
||
target_df<-new_df[,c(1:i,ncol(new_df))] | ||
|
||
target_df<-target_df%>% | ||
group_by_at(c(target_cols))%>% | ||
summarise(value=sum(value))%>% | ||
rowwise()%>% | ||
#mutate(ids = paste0(!!!syms(target_cols)))%>% | ||
unite(ids,target_cols2, sep = " - ", remove = FALSE)%>% | ||
unite(parents,target_parent, sep = " - ", remove = FALSE)%>% | ||
ungroup() | ||
|
||
out<-data.frame(ids=target_df$ids, | ||
parents=target_df$parents, | ||
labels=target_df[[target_label]], | ||
values=target_df$value, | ||
stringsAsFactors = FALSE) | ||
|
||
return(out) | ||
|
||
})) | ||
|
||
print(sb_df) | ||
data_formated(sb_df) | ||
data_ready(TRUE) | ||
} | ||
} | ||
) | ||
|
||
#observeEvent(c(input$stat,input$granu,input$number),{ | ||
output$plot<-renderPlotly({ | ||
data_formating() | ||
|
||
if(isTRUE(data_ready())){ | ||
|
||
p<-data_formated()%>%plot_ly(ids = ~ids, labels = ~labels, parents = ~parents,values= ~values, type = 'sunburst',branchvalues = 'total',maxdepth = 5,hoverinfo="label+value+percent parent+percent root") | ||
|
||
|
||
} | ||
}) | ||
# }) | ||
|
||
output$table<-DT::renderDT(server = FALSE, { | ||
|
||
data_formating() | ||
|
||
if(isTRUE(data_ready())){ | ||
|
||
|
||
DT::datatable( | ||
data_for_table(), | ||
extensions = c("Buttons"), | ||
escape = FALSE, | ||
filter = list(position = 'top',clear =FALSE), | ||
options = list( | ||
dom = 'Bfrtip', | ||
scrollX=TRUE, | ||
pageLength=5, | ||
orientation ='landscape', | ||
buttons = list( | ||
list(extend = 'copy'), | ||
list(extend = 'csv', filename = i18n("STATISTIC_DATA_EXPORT_FILENAME"), title = NULL, header = TRUE), | ||
list(extend = 'excel', filename = i18n("STATISTIC_DATA_EXPORT_FILENAME"), title = NULL, header = TRUE), | ||
list(extend = "pdf", pageSize = 'A4',orientation = 'landscape',filename = i18n("STATISTIC_DATA_EXPORT_FILENAME"), | ||
title = i18n("STATISTIC_PDF_TITLE"), header = TRUE) | ||
), | ||
exportOptions = list( | ||
modifiers = list(page = "all",selected=TRUE) | ||
), | ||
language = list(url = i18n("STATISTIC_TABLE_LANGUAGE")) | ||
) | ||
) | ||
} | ||
|
||
}) | ||
|
||
output$result<-renderUI({ | ||
switch(mode, | ||
'plot+table'={ | ||
tabsetPanel( | ||
tabPanel(i18n("TABPANEL_PLOT"),plotlyOutput(ns("plot"))%>%withSpinner(type = 4)), | ||
tabPanel(i18n("TABPANEL_STATISTIC"),DTOutput(ns("table"))%>%withSpinner(type = 4)) | ||
) | ||
}, | ||
'table+plot'={ | ||
tabsetPanel( | ||
tabPanel(i18n("TABPANEL_STATISTIC"),DTOutput(ns("table"))%>%withSpinner(type = 4)), | ||
tabPanel(i18n("TABPANEL_PLOT"),plotlyOutput(ns("plot"))%>%withSpinner(type = 4)) | ||
) | ||
}, | ||
'plot'={ | ||
plotlyOutput(ns("plot"))%>%withSpinner(type = 4) | ||
}, | ||
'table'={ | ||
DTOutput(ns("table"))%>%withSpinner(type = 4) | ||
} | ||
) | ||
}) | ||
|
||
}) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,46 @@ | ||
#' @name sunburst_chart_ui | ||
#' @aliases sunburst_chart_ui | ||
#' @title sunburst_chart_ui | ||
#' @description \code{sunburst_chart_ui} UI part of sunburst_chart module | ||
#' | ||
#' @usage sunburst_chart_ui(id,title,sliderWidth,backgroundColor,sliderOpen) | ||
#' | ||
#' @param id specific id of module to be able to link ui and server part | ||
#' @param title title of th box | ||
#' @param sliderWidth numeric, width of slider | ||
#' @param backgroundColor color of slider background | ||
#' @param sliderOpen whether the sidebar is open at start. FALSE by default. | ||
|
||
#' | ||
|
||
sunburst_chart_ui <- function(id,title="",sliderWidth = 25,backgroundColor="#333a40",sliderOpen=FALSE) { | ||
ns<-NS(id) | ||
|
||
tagList( | ||
tags$style( | ||
HTML(" | ||
.rank-list-container.default-sortable { | ||
background-color: #c6c6c6; | ||
} | ||
.default-sortable .rank-list-item { | ||
background-color: #62a0ca; | ||
} | ||
") | ||
), | ||
shinydashboardPlus::box( | ||
title=title, | ||
width = 12, | ||
sidebar = shinydashboardPlus::boxSidebar( | ||
id=ns("box"), | ||
width = sliderWidth, | ||
background = backgroundColor, | ||
startOpen = sliderOpen, | ||
style = 'font-size:14px;', | ||
uiOutput(ns("select_variable")), | ||
), | ||
uiOutput(ns("result")) | ||
) | ||
) | ||
|
||
|
||
} |