# ------------------------------------------------------------------------ # # Title : Module choix groupe # By : Vic # Date : 2018-04-12 # # ------------------------------------------------------------------------ # Packages ---------------------------------------------------------------- library("shiny") # Funs -------------------------------------------------------------------- toggleBtnUi <- function(message) { js <- sprintf( paste( "Shiny.addCustomMessageHandler('%s', function(data) {", "if (data.type == 'disable') {", "$('#' + data.id).prop('disabled', true);", "$('#' + data.id).addClass('disabled');", "}", "if (data.type == 'enable') {", "$('#' + data.id).prop('disabled', false);", "$('#' + data.id).removeClass('disabled');", "}", "});", collapse = "\n" ) , message ) tags$script(js) } toggleBtnServer <- function(session, message, id, type = "disable") { session$sendCustomMessage( type = message, message = list(id = id, type = type) ) } # Module ------------------------------------------------------------------ choixGroupeUI <- function(id) { ns <- NS(id) tagList( tags$div(id = ns("placeholder-grp-select")), tagList( tags$div( class="btn-group btn-group-justified", role="group", tags$div( class="btn-group", role="group", actionButton(inputId = ns("remove_grp"), label = "Enlever un groupe", icon = icon("minus")) ), tags$div( class="btn-group", role="group", actionButton(inputId = ns("add_grp"), label = "Ajouter un groupe", icon = icon("plus")) ) ), toggleBtnUi(ns("toggle-btn")) ) ) } choixGroupeServer <- function(input, output, session, choix, n_grp_init = 2, n_grp_min = 2, n_grp_max = 10) { # Namespace ns <- session$ns jns <- function(id) paste0("#", ns(id)) if (n_grp_init == n_grp_min) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "disable") } # Initialisation insertUI( selector = jns("placeholder-grp-select"), ui = tagList( lapply( X = seq_len(n_grp_init), FUN = function(i) { tags$div( id = ns(paste0("ctn-grp-", i)), selectizeInput( inputId = ns(paste0("grp_", i)), label = paste("Groupe", i), multiple = TRUE, width = "100%", choices = isolate(choix()), selected = "", options = list(plugins = list("remove_button")) ) ) } ) ) ) # Nombre de groupe nbre_grp <- reactiveValues(x = n_grp_init) # Id des selectize grp_id <- reactiveValues(x = paste0("grp_", n_grp_init)) # List choix choix_select <- reactiveValues() observeEvent(reactiveValuesToList(input), { for (i in seq_len(n_grp_max)) { if (i <= nbre_grp$x) { choix_select[[paste0("grp_", i)]] <- input[[paste0("grp_", i)]] } } }, ignoreNULL = FALSE) observeEvent(input$add_grp, { lesautres <- seq_len(nbre_grp$x) lesautreschoix <- lapply(lesautres, function(x) choix_select[[paste0("grp_", x)]]) lesautreschoix <- unlist(lesautreschoix, use.names = FALSE) nbre_grp$x <- nbre_grp$x + 1 if (nbre_grp$x > n_grp_min) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "enable") } else { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "disable") } if (!is.null(n_grp_max)) { if (nbre_grp$x <= n_grp_max) { grp_id$x <- c(grp_id$x, paste0("grp_", nbre_grp$x)) insertUI( selector = jns("placeholder-grp-select"), where = "beforeEnd", ui = tags$div( id = ns(paste0("ctn-grp-", nbre_grp$x)), selectizeInput( inputId = ns(paste0("grp_", nbre_grp$x)), label = paste("Groupe", nbre_grp$x), multiple = TRUE, width = "100%", choices = setdiff(choix(), lesautreschoix), selected = NULL, options = list(plugins = list("remove_button")) ) ) ) } if (nbre_grp$x == n_grp_max) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("add_grp"), type = "disable") } else { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("add_grp"), type = "enable") } } else { grp_id$x <- c(grp_id$x, paste0("grp_", nbre_grp$x)) insertUI( selector = jns("placeholder-grp-select"), where = "beforeEnd", ui = tags$div( id = ns(paste0("ctn-grp-", nbre_grp$x)), selectizeInput( inputId = ns(paste0("grp_", nbre_grp$x)), label = paste("Groupe", nbre_grp$x), multiple = TRUE, width = "100%", selected = "", choices = setdiff(choix(), lesautreschoix), options = list(plugins = list("remove_button")) ) ) ) if (nbre_grp$x == n_grp_min) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "disable") } else { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "enable") } } }) observeEvent(input$remove_grp, { # if (nbre_grp$x > n_grp_min) { removeUI(selector = jns(paste0("ctn-grp-", nbre_grp$x)), immediate = TRUE) choix_select[[paste0("grp_", nbre_grp$x)]] <- NULL nbre_grp$x <- nbre_grp$x - 1 # if (nbre_grp$x > n_grp_min) { # # } if (nbre_grp$x == n_grp_min) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "disable") } else { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("remove_grp"), type = "enable") } if (nbre_grp$x < n_grp_max) { toggleBtnServer(session, message = ns("toggle-btn"), id = ns("add_grp"), type = "enable") } # } }) # Update des choix si le nombre de modalite change en entree du module observeEvent(choix(), { lapply( X = seq_len(n_grp_max), FUN = function(x) { celuila <- x lesautres <- setdiff(seq_len(n_grp_max), celuila) lesautreschoix <- lapply(lesautres, function(x) {choix_select[[paste0("grp_", x)]]}) lesautreschoix <- unlist(lesautreschoix, recursive = TRUE, use.names = FALSE) updateSelectizeInput( session = session, inputId = paste0("grp_", x), choices = setdiff(choix(), lesautreschoix), selected = intersect(choix(), choix_select[[paste0("grp_", x)]]) ) } ) }) # Choix dependant d'un select a l'autre lapply( X = seq_len(n_grp_max), FUN = function(x) { celuila <- x lesautres <- setdiff(seq_len(n_grp_max), celuila) observeEvent( list( lapply(lesautres, function(x) {choix_select[[paste0("grp_", x)]]}) ), { leschoix <- choix() lesautreschoix <- lapply(lesautres, function(x) {choix_select[[paste0("grp_", x)]]}) lesautreschoix <- unlist(lesautreschoix, recursive = TRUE, use.names = FALSE) ceschoix <- choix_select[[paste0("grp_", celuila)]] updateSelectizeInput( session = session, inputId = paste0("grp_", celuila), choices = setdiff(leschoix, lesautreschoix), selected = ceschoix ) } ) } ) # Pour retourner uniquement le nbre de grp selectionne # return(reactive(reactiveValuesToList(choix_select))) return(reactive(reactiveValuesToList(choix_select)[seq_len(nbre_grp$x)])) } # App --------------------------------------------------------------------- # ui ---- ui <- fluidPage( tags$h2("Module choix groupes"), fluidRow( column( width = 4, sliderInput( inputId = "modalites", label = "Modalités", min = 2, max = 26, value = 5 ), choixGroupeUI("grrrr") ), column( width = 8, verbatimTextOutput(outputId = "res_mod") ) ) ) # server ---- server <- function(input, output, session) { modalites_r <- reactive({ LETTERS[seq_len(input$modalites)] }) res <- callModule(module = choixGroupeServer, id = "grrrr", choix = modalites_r) output$res_mod <- renderPrint(res()) } # app ---- shinyApp(ui = ui, server = server)