still learning how to use Shiny/R, sorry if the answer is obvious
trying to cast on the map various layers based on selectize choices (multiple)
So i got:
selectizeInput('bays', 'Select rough bay outlines',
choices = list("Residents" = "residents", `Pay to park` = "ptp",
"Shared use" = "shared"), multiple = TRUE)
Every equivalent is a geojson file that should be used for the map (here "residents", but of course it populates with a selected option from the selectize input):
topoData <- readLines("residents.geojson", warn = FALSE)
%>% paste(collapse = "\n")
leafletProxy("mymap") %>%
addPolylines(topodata)
how can i construct the observeEvent(input$bays,...) so every choice triggers the action above (with the right geojson file of course)? I can do it for a single choice but a multiple choice might call for another way. And would it be more effective to use a submit button or react to actions? Please note that it can be either adding or removing value from the selectize list? And finally there is a cool gadget in selectize - plugin "remove_button" - adding the entries with a little marker to remove the item - i have seen it for javascript but not for shiny - is it possible somehow?
$('#input-tags3').selectize({
plugins: ['remove_button'],
delimiter: ',',
persist: false,
create: function(input) {
return {
value: input,
text: input
}
}
});
You do not want an observeEvent but a reactive. Something like this should work:
# server
topoData <- reactive(
paste(
lapply(
paste0(input$bays,".geojson"), function(geojson) {
readLines(geojson)
}
),collapse="\n")
)
leafletProxy %>% addPolyLines(topoData())
input$bays is a vector of the selected geojson files, and it is reactive so as people change the selectize input the value updates in the server inside of reactive statements (and observe statements).
topoData is a reactive the returns the geojson files that are selected. If I understand correctly you just went to paste the different files on top of each into a single character. The leafletProxy may have to go inside an observe, I'm not sure.
Related
Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)
I have a Shiny app that use a fileInput to get some files client-side (I cannot use shinyFiles package that manages files server-side).
I want the user to be only able to upload files matching a specific pattern (e.g. helloWorld.txt) not only matching a file type (e.g. text, csv, etc.).
fileInput has an accept argument where you can provide accepted file types. From the doc:
accept A character vector of MIME types; gives the browser a hint of
what kind of files the server is expecting.
I do not just want to specify accepted file types, which is not restrictive enough for my app. Is there a way to do this?
Here is a MWE to accept only text files:
library(shiny)
ui <- fluidPage(
fileInput(
"file_choice",
label = "Choose a files",
multiple = TRUE,
accept = c(
".txt"
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
If I use:
accept = c(
"helloWorld.txt"
)
It does not work because it is not a MIME type.
This page Shiny fileInput parameter "accept" issue proposes to handle the selected file afterward server-side, which is what I will end up doing, but I would prefer a restriction a priori and not a posteriori (to avoid the server-side file checking and feedback to user).
One method is to interject some javascript as an onchange event trigger that checks the filename and, if it doesn't match, interrupt the upload process. This method uses an alert, I know many consider this method to be a bit invasive and not great aesthetics, I'm sure others can make better suggestions.
I should start with a simple caveat: the conditional here is strictly "the filename begins with the literal hello". Your example might require a little more finesse, instead requiring the filename sans-extension to match. In that case, regular expressions might be in order, reference something like https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions for more info. What this answer provides is a framework for you to fill in the holes.
(While modifying this code, you might find it useful to add alert(FileName) and/or alert(FileBase) to see what javascript is comparing against your pattern. It will popup with every attempt. In my case here, it helped me discover that, not surprisingly, the windows path was present, meaning it was using backslashes instead of forward-slashes, necessitating the split(/[\\/]/), further escaped for R.)
checkjs <- 'function checkFileName(fieldObj) {
var FileName = fieldObj.value;
var FileBase = FileName.split(/[\\\\/]/).pop();
if (! FileBase.startsWith("hello")) {
fieldObj.value = "";
alert("File does not start with hello");
return false;
}
return true;
}'
attrib_replace <- function(x, cond, ...) {
if (all(names(cond) %in% names(x)) && identical(cond, x[names(cond)])) x <- c(x, list(...))
if ("attribs" %in% names(x)) x$attribs <- attrib_replace(x$attribs, cond = cond, ...)
if ("children" %in% names(x)) x$children <- lapply(x$children, function(ch) attrib_replace(ch, cond = cond, ...))
x
}
A sample app, using this:
library(shiny)
shinyApp(
ui = fluidPage(
tags$script(checkjs),
attrib_replace(fileInput(
"file_choice",
label = "Choose a file",
multiple = TRUE,
accept = c(".txt")
), list(id = "file_choice", type = "file"), onchange = "checkFileName(this);")
),
server = function(input, output, session) {}
)
When you select a file that does not start with "hello", it gives an alert and does not upload the file. A proper file uploads just file.
Some other answers I referenced for this:
How stop file upload event using javascript
Need a basename function in Javascript
I'm trying to update a text box based on the click events in multiple graphs. I use the observeEvent function to trigger the update of the text box. A snippet of the code is shown below.
observeEvent({
input$plot1_click
input$plot2_click
input$plot3_click
...
}, {
# only need the invalidated input
invalid_input <- which.invalid(input$plot1_click,
input$plot2_click,
input$plot3_click,
...)
updateTextInput(session,
"textbox",
label = NULL,
value = invalid_input)
})
Currently the updateTextInput function will run whenever there's a click in any of the plots, which is desired, but I can't figure out how to capture which plot is clicked last and should be used to update the text input. Is there a function to check which input is invalidated from a list of inputs?
Hi I think the easiest way is to make a separate observer for each input. This way the input that was changed last will always processed last. You can put it in a lapply if you don't want to bloat you code with repetitive code. It could look something like this
lapply(1:3, function(idx){
observeEvent({input[[paste0("plot",idx,"_click")]]},
{updateTextInput(session,
"textbox",
label = NULL,
value = input[[paste0("plot",idx,"_click")]])})
})
Hope this helps!
I am using Shiny as an interface for viewing tables stored locally in a series of .RData files however I am unable to get the table to render.
My server code is like this:
output$table1 <- renderTable({
load(paste0(input$one,"/",input$two,".RData"))
myData})
On the ui side I am simply displaying the table in the main panel.
This other SO question suggests that the issue is that the environment that the data is loaded into goes away so the data isn't there to display. They suggest creating a global file and loading the .RData file in there, but I don't believe I will be able to load the data dynamically that way. Any guidance on how to use .RData files effectively within shiny would be appreciated.
Regards
I think you just need to move the load statement outside of the renderTable function. So you should have
load(paste0(input$one,"/",input$two,".RData"))
output$table1 <- renderTable({myData})
If you look at the help file for renderTable, the first argument is
expr: An expression that returns an R object that can be used with
xtable.
load does not return this.
I got around this by "tricking" R Shiny. I make a BOGUS textOutput, and in renderText, call a external function that, based in the input selected, sets the already globally loaded environments to a single environment called "e". Note, you MUST manually load all RDatas into environments in global.R first, with this approach. Assuming your data isn't that large, or that you don't have a million RDatas, this seems like a reasonable hack.
By essentially creating a loadEnvFn() like the below that returns a string input passed as input$datasetNumber, you can avoid the scoping issues that occur when you put code in a reactive({}) context. I tried to do a TON of things, but they all required reactive contexts. This way, I could change the objects loaded in e, without having to wrap a reactive({}) scope around my shiny server code.
#Global Environment Pre-loaded before Shiny Server
e = new.env()
dataset1 = new.env()
load("dataset1.RData", env=dataset1)
dataset2 = new.env()
load("dataset2.RData", env=dataset2)
dataset3 = new.env()
load("dataset3.RData", env=dataset3)
ui = fluidPage(
# Application title
titlePanel(title="View Datasets"),
sidebarLayout(
# Sidebar panel
sidebarPanel(width=3, radioButtons(inputId = "datasetNumber", label = "From which dataset do you want to display sample data?", choices = list("Dataset1", "Dataset2", "Dataset3"), selected = "Dataset2")
),
# Main panel
mainPanel(width = 9,
textOutput("dataset"), # Bogus textOutput
textOutput("numInEnv")
)
)
)
loadEnvFn = function(input) {
if (input$datasetNumber=="Dataset1") {
.GlobalEnv$e = dataset1
} else if (input$datasetNumber=="Dataset2") {
.GlobalEnv$e = dataset2
} else {
.GlobalEnv$e = dataset3
}
# Bogus return string unrelated to real purpose of function loadEnvFn
return(input$datasetNumber)
}
server = function(input, output, session) {
output$dataset = renderText(sprintf("Dataset chosen was %s", loadEnvFn(input))) # Bogus output
output$numInEnv = renderText(sprintf("# objects in environment 'e': %d", length(ls(e))))
}
shinyApp(ui, server)
My Shiny app has several inputs which are used to define several parameters of a generated plot. It's very likely that the user will spend some minutes going through all possible options until he's satisfied with the output. Obviously the plot can be exported in different formats, but it's possible that the user will want to recreate the same plot with different data later, or maybe just change one small detail.
Because of this, I need to offer the user a way to export all his settings and keep that file for later use. I've developed an approach, but it isn't working well. I'm using reactiveValuesToList to get the names of all input elements and save as a simple text file with the format inputname=inputvalue. This is the downloadHandler on server.R:
output$bt_export <- downloadHandler(
filename = function() {
"export.txt"
},
content = function(file) {
inputsList <- names(reactiveValuesToList(input))
exportVars <- paste0(inputsList, "=", sapply(inputsList, function(inpt) input[[inpt]]))
write(exportVars, file)
})
This works fine, but loading isn't going very smoothly. Since I don't (and couldn't figure out how) save the input type, I have to update the values blindly. This is how I do it:
importFile <- reactive({
inFile <- input$fileImport
if (is.null(inFile))
return(NULL)
lines <- readLines(inFile$datapath)
out <- lapply(lines, function(l) unlist(strsplit(l, "=")))
return(out)
})
observe({
imp <- importFile()
for (inpt in imp) {
if (substr(inpt[2], 0, 1) == "#") {
shinyjs::updateColourInput(session, inputId = inpt[1], value = inpt[2])
} else {
try({
updateTextInput(session, inputId = inpt[1], value = inpt[2])
updateNumericInput(session, inputId = inpt[1], value = inpt[2])
updateSelectInput(session, inputId = inpt[1], selected = inpt[2])
})
}
}
})
Apart from the shinyjs::colorInput, which can be recognized by the # start, I have to use try() for the others. This works, partially, but some inputs are not being updated. Inspecting the exported file manually shows that inputs which weren't updated are there, so I suppose that updating 100+ inputs at once isn't a good idea. Also the try() part doesn't look good and is probably not a good idea.
The app is close to finished, but will probably be updated in the future, having some inputs added/changed. It's acceptable if this even make some "old" exported inputs invalid, since I'll try keep the backwards compatibility. But I'm looking for an approach that isn't just writing hundreds of lines to update the inputs one-by-one.
I've thought about using save.image() but simply using load() does not restore the app inputs. I also considered a way to somehow update all inputs at once, instead of one-by-one, but didn't come up with anything. Is there any better way to export all user inputs to a file and then load them all? It doesn't matter if it's a tweak to this one that works better or a completely different approach.
If you look at the code of the shiny input update functions, they end by session$sendInputMessage(inputId, message). message is a list of attributes that need to be changed in the input, for ex, for a checkbox input: message <- dropNulls(list(label = label, value = value))
Since most of the input have the value attribute, you can just use the session$sendInputMessage function directly on all of them without the try.
Here's an example, I created dummy_data to update all the inputs when you click on the button, the structure should be similar to what you export:
ui.R
library(shiny)
shinyUI(fluidPage(
textInput("control_label",
"This controls some of the labels:",
"LABEL TEXT"),
numericInput("inNumber", "Number input:",
min = 1, max = 20, value = 5, step = 0.5),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1",
"label 2" = "option2",
"label 3" = "option3")),
actionButton("update_data", "Update")
))
server.R
library(shiny)
dummy_data <- c("inRadio=option2","inNumber=10","control_label=Updated TEXT" )
shinyServer(function(input, output,session) {
observeEvent(input$update_data,{
out <- lapply(dummy_data, function(l) unlist(strsplit(l, "=")))
for (inpt in out) {
session$sendInputMessage(inpt[1], list(value=inpt[2]))
}
})
})
All the update functions also preformat the value before calling session$sendInputMessage. I haven't tried all possible inputs but at least for these 3 you can pass a string to the function to change the numericInput and it still works fine.
If this is an issue for some of your inputs, you might want to save reactiveValuesToList(input) using save, and when you want to update your inputs, use load and run the list in the for loop (you'll have to adapt it to a named list).
This is a bit old but I think is usefull to post a complete example, saving and loading user inputs.
library(shiny)
ui <- shinyUI(fluidPage(
textInput("control_label",
"This controls some of the labels:",
"LABEL TEXT"),
numericInput("inNumber", "Number input:",
min = 1, max = 20, value = 5, step = 0.5),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1",
"label 2" = "option2",
"label 3" = "option3")),
actionButton("load_inputs", "Load inputs"),
actionButton('save_inputs', 'Save inputs')
))
server <- shinyServer(function(input, output,session) {
observeEvent(input$load_inputs,{
if(!file.exists('inputs.RDS')) {return(NULL)}
savedInputs <- readRDS('inputs.RDS')
inputIDs <- names(savedInputs)
inputvalues <- unlist(savedInputs)
for (i in 1:length(savedInputs)) {
session$sendInputMessage(inputIDs[i], list(value=inputvalues[[i]]) )
}
})
observeEvent(input$save_inputs,{
saveRDS( reactiveValuesToList(input) , file = 'inputs.RDS')
})
})
Unless you're doing a lot of highly flexible type inputs (renderUI blocks which could be any sort of input) then you could create a list storing all current values, use dput to save them to a file with a corresponding dget to read it in.
In one app I have, I allow users to download a file storing all their uploaded data plus all their options.
output$saveData <- downloadHandler(
filename = function() {
paste0('Export_',Sys.Date(),'.sprout')
},
content = function(file) {
dataToExport = list()
#User specified options
dataToExport$sproutData$transformations=sproutData$transformations #user specified transformations
dataToExport$sproutData$processing=sproutData$processing #user specified text processing rules
dataToExport$sproutData$sc=sproutData$sc #user specified option to spell check
dataToExport$sproutData$scOptions=sproutData$scOptions #user specified spell check options (only used if spell check is turned on)
dataToExport$sproutData$scLength=sproutData$scLength #user specified min word lenght for spell check (only used if spell check is turned on)
dataToExport$sproutData$stopwords=sproutData$stopwords #user specified stopwords
dataToExport$sproutData$stopwordsLastChoice=sproutData$stopwordsLastChoice #last pre-built list selected
dput(dataToExport,file=file)
}
)
Here I make an empty list, then I stick in the values I use in my app. The reason for the dTE$sD$name structure is that I have a reactiveValues called sproutData which stores all user selected options and data. So, I preserve the structure in the output.
Then, I have a load data page which does the following:
output$loadStatusIndicator = renderUI({
worked = T
a = tryCatch(dget(input$loadSavedData$datapath),error=function(x){worked<<-F})
if(worked){
#User specified options
a$sproutData$transformations->sproutData$transformations #user specified transformations
a$sproutData$processing->sproutData$processing #user specified text processing rules
updateCheckboxGroupInput(session,"processingOptions",selected=sproutData$processing)
a$sproutData$sc->sproutData$sc #user specified option to spell check
updateCheckboxInput(session,"spellCheck",value = sproutData$sc)
a$sproutData$scOptions->sproutData$scOptions #user specified spell check options (only used if spell check is turned on)
updateCheckboxGroupInput(session,"spellCheckOptions",selected=sproutData$scOptions)
a$sproutData$scLength->sproutData$scLength #user specified min word lenght for spell check (only used if spell check is turned on)
updateNumericInput(session,"spellCheckMinLength",value=sproutData$scLength)
a$sproutData$stopwords->sproutData$stopwords #user specified stopwords
a$sproutData$stopwordsLastChoice->sproutData$stopwordsLastChoice
if(sproutData$stopwordsLastChoice[1] == ""){
updateSelectInput(session,"stopwordsChoice",selected="none")
} else if(all(sproutData$stopwordsLastChoice == stopwords('en'))){
updateSelectInput(session,"stopwordsChoice",selected="en")
} else if(all(sproutData$stopwordsLastChoice == stopwords('SMART'))){
updateSelectInput(session,"stopwordsChoice",selected="SMART")
}
HTML("<strong>Loaded data!</strong>")
} else if (!is.null(input$loadSavedData$datapath)) {
HTML(paste("<strong>Not a valid save file</strong>"))
}
})
The actual output is a table which details what it found and what it set. But, because I know all the inputs and they don't change, I can explicitly store them (default or changed value) and then explicitly update them when the save file is uploaded.