Skip to content

Instantly share code, notes, and snippets.

@jcheng5
Forked from Athospd/server.R
Last active April 17, 2018 01:32
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 4 You must be signed in to fork a gist
  • Save jcheng5/eaedfed5095d37217fca to your computer and use it in GitHub Desktop.
Save jcheng5/eaedfed5095d37217fca to your computer and use it in GitHub Desktop.
library(shiny)
library(magrittr)
shinyServer(function(input, output, session) {
#__________________________________________________________________________________
# The main named list that will be used in many other tasks.
listN <- reactiveValues()
makeReactiveBinding("listN")
output$uiAdded <- renderUI({
selectInput('added',
'List of combinations',
choices = names(listN),
multiple = TRUE,
selectize = FALSE)
})
#__________________________________________________________________________________
observe({
# Trigger Add actions
input$actionBtnAdd
isolate({
new_selections <- input$add
new_selections_name <- new_selections %>% paste(collapse = " X ")
if(new_selections_name != "")
listN[[new_selections_name]] <- new_selections
})
})
#__________________________________________________________________________________
observe({
# Trigger Remove actions
input$actionBtnAdded
isolate({
# identify the items selected by user to be removed
selections_to_remove <- input$added
listNAsList <- list()
# Here I manipulate 'listN' by converting it to list (using 'reactiveValuesToList()')
if(!is.null(selections_to_remove)) {
# To list so it can have their items removed
listNAsList <- reactiveValuesToList(listN)
# remove those items selected in input$added
sapply(selections_to_remove, function(x) {
listNAsList[[x]] <<- NULL
return(NULL)
}) %>% invisible
}
# Now, I'll try to update 'listN' by recreating it from scratch with only the remaining items in listNAsList object.
list_names_for_choices <- names(listNAsList)
if(is.null(list_names_for_choices)) { # if there is no items left...
# ...an empty list is returned (without options, as desired)
#listN <- reactiveValues()
# Here is a workaround to clear the 'added' list. NULL or character(0) would keep selectInput unchanged.
list_names_for_choices <- ""
} else { # if there is some remaining items on 'added' input list...
# ...update listN with it.
listN <<- do.call(reactiveValues, listNAsList)
}
})
})
#__________________________________________________________________________________
# debug output to show the listN content.
output$debug <- renderPrint({
listN %>% reactiveValuesToList
})
})
library(shiny)
shinyUI(fluidPage(
titlePanel("reactiveValue Issue"),
tags$p("I need to be able to add and remove items from a reactiveValues object, but its items is annoyingly persistent. Please, help me to figure out WHY."),
fluidRow(
column(2,
selectInput('add',
'Multiple Choices',
LETTERS[1:10],
multiple = TRUE,
selectize = TRUE),
actionButton('actionBtnAdd',
'Add',
icon("plus"))
),
column(2,
uiOutput("uiAdded"),
actionButton('actionBtnAdded',
'Remove',
icon("minus"))
),
column(6, offset = 1,
h4('debug area: "listN" content, the object of interest'),
verbatimTextOutput('debug')
)
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment