Skip to content

Instantly share code, notes, and snippets.

@vnijs
Forked from Athospd/server.R
Last active August 29, 2015 14:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save vnijs/b6f4e1a0ca245bf32e9f to your computer and use it in GitHub Desktop.
Save vnijs/b6f4e1a0ca245bf32e9f 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()
#__________________________________________________________________________________
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
})
updateSelectInput(session,
inputId = "added",
choices = names(listN))
})
#__________________________________________________________________________________
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)
}
})
# Update select Input 'added' to show users the items created by them.
updateSelectInput(session,
inputId = "added",
choices = list_names_for_choices)
})
#__________________________________________________________________________________
# 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,
selectInput('added',
'List of combinations',
choices = c(),
multiple = TRUE,
selectize = FALSE),
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