Hello, I would like to make a Sankey diagram in a dynamic Dashboard.
I have two tables that are stored in a list (libs)
For that, I have created a function that allows me to do that. But when I put the function in a highcharter::renderHighchart, I get the error message "
Error in UseMethod: no method for 'rename' applicable for an object of class "NULL"
---
title: "Dashboard d'analyse Profilx"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
theme:
bg: "#fcfcfc"
fg: "#8e868f"
primary: "#008CBA"
font_scale: 0.85
base_font: !expr bslib::font_google("Prompt")
code_font: !expr bslib::font_google("JetBrains Mono")
source_code: embed
runtime: shiny
---
```{r setup, include=FALSE}
library(dplyr)
library(purrr)
library(data.table)
library(flexdashboard)
library(highcharter)
library(featurize)
library(DT)
library(stringi)
library(stringr)
library(glue)
library(ggplot2)
library(grid)
library(tidyr)
library(plotly)
library(readxl)
library(readr)
library(reactable)
library(billboarder)
library(shiny)
library(scales)
library(shinyWidgets)
library(bsts)
library(viridis)
library(bslib)
library(aws.s3)
library(profvis)
thematic::thematic_rmd(
font = "auto",
# To get the dark bg on the geom_raster()
sequential = thematic::sequential_gradient(fg_low = FALSE, fg_weight = 0, bg_weight = 1)
)
theme_set(theme_bw(base_size = 20))
Sys.setenv("aws_access_key_id" = "",
"aws_secret_access_key" = "",
"aws_region" = "eu-west-1",
"aws_default_region" = "eu-west-1",
"aws_session_token" = "")
list = aws.s3::get_bucket_df("cdh-dsdevmodels-382109",
prefix = "profilxmodels/stage=all") %>%
pull(Key)
version <- list %>%
gsub(".*version=(.+)/model.*", "\\1",.)
lib_files <- setNames(list, version)
libs <- purrr::map(lib_files, ~s3readRDS(object = .x, bucket = "cdh-dsdevmodels-382109"))
Version {.sidebar}
selectInput(inputId = "lib_version",
label = "Selectionner une version :",
choices = lib_files)
selectInput(inputId = "segment_type",
label = "Selectionner un segment :",
choices = c("C3_C4","C2"),
selected = "C3_C4")
selectInput(inputId = "Niveau",
label = "Selectionner le niveau :",
choices = 1:5)
version_actual <- reactive({
req(input$lib_version)
gsub(".*version=(.+)/model.*", "\\1", input$lib_version)
})
bib <- reactive({
req(input$lib_version, version_actual())
x <- libs[[version_actual()]]
if (version_actual() == "0.1.0") {
l <- list()
l$tlp_lib <- list()
l$model <- list()
l$tlp_lib$C3_C4 <- x$tlp_lib
l$tlp_lib$C2 <- NULL
l$model$C2 <- NULL
l$model$C3_C4 <- x$model
l$model$C3_C4$pre$actions$recipe$recipe$template <- l$model$C3_C4$pre$actions$recipe$recipe$template %>%
rename(CLUST = CLUST6)
x <- l
}
x
})
observe({
if(is.null(bib()$tlp_lib$C2)) {
updateSelectInput(session, inputId = "segment_type", choices = "C3_C4")
} else{
updateSelectInput(session, inputId = "segment_type", choices = c("C3_C4","C2"))
}
})
# The fonction
sankey_function <- function(old_clust, new_clust, version_to_compare) {
new_clust <- rename(new_clust, new := CLUST)
old_clust <- rename(old_clust, old := CLUST)
df <- inner_join(old_clust, new_clust) %>%
group_by(new, old) %>%
summarise(nb_mp_code = n()) %>%
mutate(new := paste0(as.character(version_to_compare), ' : ', new),
old := paste0(as.character(version_actual()), ' : ', old))
hchart(df, "sankey", hcaes(from = old, to = new, weight = nb_mp_code)) %>%
hc_boost(enabled = TRUE)
}
highcharter::renderHighchart({
req(bib())
version[!version %in% c(version_actual())] %>%
purrr::map(
~ sankey_function(
libs[[.x]]$model$C3_C4$pre$actions$recipe$recipe$template,
bib()$model$C3_C4$pre$actions$recipe$recipe$template,
.x
)
)
})