I have the following app:
If you click next, you will see a plot - at the moment with trivial information - and have to choose two radiobutton options: yes or no. Then you can click on the next button and evaluate the next plot. The problem is, that you have to first click on the button to show the first plot. Also you see in the print statement a missmatch. The first radio button choice is printed in the second line instad of the first print statement.
Can you help me to show an initial plot?
ui <- fluidPage(
actionButton("buttonNext", "Next"),
radioButtons("radio", "Your Decision:",
choices = c("No Decision" = 'NoDec', "Yes" = 'yes', "No" = 'no'),
selected = 'NoDec'),
plotOutput("TimeSeriesPlot")
)
server <- function(input,output,session) {
observeEvent(input$buttonNext, {
})
clickNext <- eventReactive(input$buttonNext, {
updateRadioButtons(session,'radio',selected = -1)
randomNumber <- input$buttonNext
print(c(input$buttonNext,randomNumber,input$radio))
return(randomNumber)
})
output$TimeSeriesPlot <- renderPlot({
i <- clickNext()
plot(i)
})
}
shinyApp(server = server, ui = ui)
You could use a simple reactive, and isolate the statement where you call the radio button's value. This way, the reactive won't take a dependency on the radiobuttons. Also, it is considered bad practice to use a reactive for it's side-effects, better to update the radio buttons from a separate observer:
ui <- fluidPage(
actionButton("buttonNext", "Next"),
radioButtons("radio", "Your Decision:",
choices = c("No Decision" = 'NoDec', "Yes" = 'yes', "No" = 'no'),
selected = 'NoDec'),
plotOutput("TimeSeriesPlot")
)
server <- function(input,output,session) {
clickNext <- reactive({
isolate(input_radio <- input$radio)
randomNumber <- input$buttonNext
print(c(input$buttonNext,randomNumber,input_radio))
return(randomNumber)
})
observeEvent(input$buttonNext,
{
updateRadioButtons(session,'radio',selected = -1)
})
output$TimeSeriesPlot <- renderPlot({
i <- clickNext()
plot(i)
})
}
shinyApp(server = server, ui = ui)
Hope this helps.
Thank you a lot!
How is it possible to save the data the user is inserting:
print(c(input$buttonNext,randomNumber,input_radio))
This should not be just printed, but it should be available to me later.
My plan is, that people evaluate my plots and then I see for each user the buttons he clicked for each plot.
Related
I have create one app that contains a textInput and a selectizeInput. Depending on the user's input and if the input can be found in one dataset, you will see all the possibilities according to that textInput in the selectizeInput.
In this way, if the user introduces a word that it is not in the dataset, the selectizeInput can't display any choice.
Everything works fine, but I found one problem. If the user starts writing a correct word, the user gets a dropdown list... and then, if the input is removed... the dropdown list is still there (the choices from selectizeInput are still there).
Here the code:
library(shiny)
library(dplyr)
library(stringr)
ui <- fluidPage(
textInput("my_input", "Introduce a word"),
selectizeInput(inputId = "dropdown_list", label = "Choose the variable:", choices=character(0)),
)
server <- function(input, output, session) {
my_list <- reactive({
req(input$my_input)
data <- as.data.frame(storms)
res <- subset(data, (grepl(pattern = str_to_sentence(input$my_input), data$name))) %>%
dplyr::select(name)
res <- as.factor(res$name)
return(res)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$my_input, {
updateSelectizeInput(
session = session,
inputId = "dropdown_list",
choices = my_list(), options=list(maxOptions = length(my_list())),
server = TRUE
)
})
}
shinyApp(ui, server)
Do you know how can I remove the choices from the selectizeInput if the user deletes the input?
Thanks very much in advance
Regards
The issue is the req(input$myinput). Hence, if the user deletes the input my_list() does not get updated. Instead of req you could use an if to check whether the input is equal to an empty string:
my_list <- reactive({
if (!input$my_input == "") {
data <- as.data.frame(storms)
res <- subset(data, grepl(pattern = str_to_sentence(input$my_input), data$name), name)
res <- as.factor(res$name)
return(res)
}
})
I have data that looks something like the data set Orange where there are columns that might contain duplicate values, however, each row is unique.
My code:
library(shiny)
library(DT)
library(data.table)
d <- copy(Orange)
col_names <- names(Orange)
user_friendly_names <- c('TreeNumber', 'TreeAge', 'Circumference')
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Filters:"),
uiOutput("filters"),
# Plot button
fluidRow(column(2, align = "right",
actionButton("plot_graph_button", "Plot")))
),
mainPanel(tableOutput("summary"))
)
)
server <- function(input, output) {
#### Create the filter lists for UI ####
output$filters <- renderUI({
if(is.null(col_names)) return(NULL)
lapply(1:length(col_names), function(i) {
col <- paste0(col_names[i])
alias <- user_friendly_names[i]
# Populate input with unique values from column
selectizeInput(inputId = alias, label = paste(alias,':'),
choices = c('All', unique(d[[col]])), selected = 'All', multiple = T)
})
})
output$summary <- renderTable({
# Do not show a plot when the page first loads
# Wait until the user clicks "Plot" button
if (input$plot_graph_button == 0){
return()
}
# Update code below everytime the "Plot" button is clicked
input$plot_graph_button
isolate({
# Fresh copy of the full data set every time "Plot" button is clicked
d <- copy(Orange)
# Filter data based on UI
for(f in 1:length(col_names)){
print(paste("This is loop # ", f))
if(eval(parse(text = paste0('is.null(input$',user_friendly_names[f],')')))){
# If the user deleted "All" but failed to pick anything else default to "All" - do not filter
break
}else{
if(eval(parse(text = paste0('input$',user_friendly_names[f]))) != "All"){
print("FALSE -- Input is not == ALL")
d <- d[d[[col_names[f]]] == unlist(eval(parse(text = paste0('input$',user_friendly_names[f])))), ]
}else{
print("TRUE -- Input is defaulted to ALL")
}
}
}
final_summary_table <<- d
})
})
}
shinyApp(ui = ui, server = server)
My issue is that these lists are able to select multiple inputs (which I want), however, I want to initially show all available choices in all menus (which it currently does) but what I need to change is I need to have it start filtering the other lists as soon as a selection is made (no matter which list the user goes to first) based on that unique rowed data set provided.
So, if the user goes to the 2nd list and chooses tree age of 1004 then the TreeNumber menu should change to c(1, 2, 3, 4, 5) - no change in this scenario but the Circumference menu should change to c(115, 156, 108, 167, 125), then if they pick a TreeAge now the menus get filtered down by both TreeAge and TreeNumber and so on.
Right now the way the code works is it doesn't filter anything until you click "Plot", so the user might think a search will yield a bunch of results, when in reality the combination may not exist.
Here is a good example of a search that you may expect to yield a lot of results, yet it only yields 1 row:
Please note: If you do not delete 'All' it will return 'All' even if you selected other options, it is a flaw in the code that I plan to address separately along with some other minor tweaks.
I also wanted to mention that I found this post Filter one selectInput based on selection from another selectInput? which is similar to mine, however, they are dealing with menus in a top-down approach and mine is going to be more flexible about which menu the user goes to first (also mine allows multiple selections).
server <- function(input, output, session) {
output$filters <- renderUI({
# ...
})
lapply(seq_along(d), function(i) {
observeEvent(input[[user_friendly_names[i]]], {
for (j in seq_along(d)[-i]) {
choices <- if ("All" %in% input[[user_friendly_names[i]]])
unique(d[[j]]) else
unique(d[[j]][d[[i]] %in% input[[user_friendly_names[i]]]])
choices <- c("All", choices)
selected <- intersect(choices, input[[user_friendly_names[j]]])
updateSelectInput(session = session, inputId = user_friendly_names[j],
choices = choices, selected = selected)
}
})
})
observeEvent(input$plot_graph_button, {
for (j in seq_along(d)) {
updateSelectInput(session = session, inputId = user_friendly_names[j],
choices = c("All", unique(d[[j]])), selected = "All")
}
})
output$summary <- renderTable({
# ...
})
}
I have the following very simple app
funSolver <- function(server,currencyList,tenorList,tailList) {
return(do.call(rbind,lapply(currencyList,function(ccy) {
return(do.call(rbind,lapply(tenorList,function(tenor) {
return(do.call(rbind,lapply(tailList,function(myTail) {
a <- 0
b <- 10
d <- 25
e <- 35
return(data.frame(ccy=ccy,tenor=tenor,tail=myTail,a=a,b=b,d=d,e=e))
})))
})))
})))
}
ui <- fluidPage(
titlePanel("Carry Selector"),
sidebarPanel(
selectInput(inputId = 'serverListInput',label = 'Server', choices=as.list(paste("adsg-",c("l01","ln01","l02","ln02"),sep="")),multiple = FALSE,selectize = TRUE),
selectInput(inputId = 'currencyListInput',label = 'blabla', choices=list("blabla1","blabla2","blabla3"),multiple = TRUE,selectize = TRUE),
fluidRow(
column(6,selectInput(inputId = 'tenorListInput',label = 'Tenors', choices=as.list(c("All",paste(c(1,3,6),"m",sep=""),paste(c(seq(1,9),seq(10,30,5)),"y",sep=""))),multiple = TRUE,selectize = TRUE)),
column(6,selectInput(inputId = 'tailListInput',label = 'Tails', choices=as.list(c("All",paste(c(1,2,3,5,7,10,15,20),"y",sep=""))),multiple = TRUE,selectize = TRUE))
),
actionButton(inputId = 'launchCalcButton',label = 'Launch Calc')
),
mainPanel(
fluidRow(
column(12,dataTableOutput(outputId = 'table'))
)
)
)
server <- function(input,output){
observeEvent(input$launchCalcButton, {
output$table <- renderDataTable({
datatable(funSolver(input$serverListInput,input$currencyListInput,input$tenorListInput,input$tailListInput))
})
})
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')
You choose a few parameters and click on the button to show the table generated by the funSolver function. I have wrapped the button call into an observeEvent so the table is generated only when you click. I do not understand why, if you change parameters after the button is first clicked, the table gets updated even though I have not clicked the button.
Q1 : Is that behavior expected ?
Q2 : If it is, how to do what I want to do within a shiny app (table refreshed only when the button is clicked on, not when the parameters are updated) ?
All help appreciated
You added the render function inside the observe event part which means it will run each time the dependencies change within this event. Looking at ?observeEvent gives you a very nice method to get what you want:
EDIT
I played a bit with the selectinput and button options and found out it is actually due to the multiple=TRUE argument (I believe). For some reason, this argument overrules the input button dependency in observeEvent. The version below with eventReactive however does work:
server <- function(input,output){
df = eventReactive(input$launchCalcButton, {
data.table(funSolver(input$serverListInput,input$currencyListInput,input$tenorListInput,input$tailListInput))
})
output$table <- renderDataTable({
df()
})
}
I need to allow the user to select some widgets from a fixed set of widgets and then enter a quantity for each widget he has selected.
selectInput("widgets","Widgets",choices = widgets_list,multiple = TRUE)
How can I show a set of Numeric Entry boxes dynamically, one for each item selected by the user in the multi-select box above?
Eventually I want to end up with some structure like:
data.frame(widgets=c("Widget1","Widget2","Widget3"),quantities=c(23,34,23))
Any thoughts on how best to implement this?
Here is a toy program that does what you want - I think.
It uses a reactiveValues to declare a pair of vectors that you can then be changed reactively. It uses renderUI and uiOutput to render new input devices as the underlying data changes. It also uses renderDataTable to show you the data table that is being created.
library(shiny)
widgets_list = c("Widget1","Widget2","Widget3")
widgets_quan = c(23,34,23)
u <- shinyUI(fluidPage(
titlePanel("Shiny Widgets Input"),
sidebarLayout(position = "left",
sidebarPanel(h3("sidebar panel"),
uiOutput("widgname"),
uiOutput("widgquan")
),
mainPanel(h3("main panel"),
dataTableOutput("dataframe")
)
)))
s <- shinyServer(function(input,output) {
rv <- reactiveValues(wname = widgets_list,wquan = widgets_quan)
observeEvent(input$widgquan, {
rv$wquan[ which(rv$wname==input$widget) ] <- input$widgquan
})
output$widgname <- renderUI({
selectInput("widget","Widget",choices = rv$wname)
})
output$widgquan <- renderUI({
req(input$widget)
n <- rv$wquan[which(rv$wname == input$widget)]
numericInput("widgquan","Quantity:",n)
})
widgdata <- reactive({
req(input$widgquan)
df <- data.frame(Widgets = rv$wname,Quantity = rv$wquan)
})
output$dataframe <- renderDataTable({ widgdata() })
})
shinyApp(ui = u,server = s)
yielding:
I have a textInput widget, and now whenever I start typing in the widget, shinyApp tries to evaluate the unfinished content in the textInput widget and results in many errors. I'm aware that adding an action Button "Calculate" would easily solve the problem. However, my app does not have space left for one more button. So, I'd like to know if there's a way that the textInput widget would "listen" to a keyboard event, such as when the user hits "Enter?" Thanks in advance!
Very good question. Here is an example of the way I use; this app shows a ggplot and the user gives the title of the ggplot in a textbox - but the title changes reacts only when "Return" is pressed:
js <- '
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
'
shinyApp(
ui = bootstrapPage(
tags$script(js),
textInput("title", label = "Title"),
plotOutput("ggplot")
),
server = function(input, output, session){
Title <- reactiveVal()
observeEvent(input[["keyPressed"]], {
Title(input[["title"]])
})
output[["ggplot"]] <- renderPlot({
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) +
geom_point() +
ggtitle(Title())
})
}
)
Explanations:
This Javascript code:
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
creates a new Shiny input, namely input$keyPressed which receives a random number when the "Return" key is pressed anywhere.
Then I define a reactive value which takes the value input$title given in the textbox by the user, only when input$keyPressed changes:
Title <- reactiveVal()
observeEvent(input[["keyPressed"]], {
Title(input[["title"]])
})
And finally I pass this reactive value to ggtitle:
output[["ggplot"]] <- renderPlot({
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) +
geom_point() +
ggtitle(Title())
})
Here is an app that I built, and solves a similar problem.
The idea is to have listen to both the keypress and the button, and make sure they work together well. In your case, you should be able to make something even simpler because you don't need the button.
I hope you like it.
library(shiny)
# This is a demo app to test a key binding on an actionButton
# Uncommenting the info item (on both UI and server) will display internal stuff
runApp(
list(
#############################################
# UI
#############################################
ui = bootstrapPage(
textInput ("myinput", label = "Write something here"),
tags$script('
$(document).on("keydown", function (e) {
Shiny.onInputChange("lastkeypresscode", e.keyCode);
});
'),
actionButton("GO", "Lancer le matching !"),
# verbatimTextOutput("info"),
verbatimTextOutput("results")
),
#############################################
# SERVER
#############################################
server = function(input, output, session) {
# There are state variables for the input text and GO button
curr.val <- "" # Corresponds to the current displayed input$myinput
curr.go <- 0 # Corresponds to the last known GO value (integer)
lastEvent <- reactive({
# Is reactive to the following events
input$GO
input$lastkeypresscode
# Decide which action should be taken
if(input$GO > curr.go) {
# The user pushed the GO actionButton, so take action
action <- 1
curr.go <<- input$GO
} else if(input$lastkeypresscode == 13) {
# The user pressed the Enter key, so take action
action <- 1
} else {
# The user did anything else, so do nothing
action <- 0
}
return(action)
})
output$results = renderPrint({
if(lastEvent() == 1) {
curr.val <<- isolate(input$myinput)
}
curr.val
})
# output$info = renderText({
# paste(curr.val, curr.go, input$lastkeypresscode, sep = ", ")
# })
}
)
)
I created a simple app as an example, where the user can write the name of a city and after pressing ENTER it returns latitude and longitude:
library(shiny)
library(ggmap)
runApp(
list(
#############################################
# UI
#############################################
ui = fluidPage( title = "City Search" ,
position= "static-top",
tags$script(' $(document).on("keydown", function (e) {
Shiny.onInputChange("lastkeypresscode", e.keyCode);
});
'),
# Search panel:
textInput("search_city", "" , placeholder= "City"),
verbatimTextOutput("results")),
#############################################
# SERVER
#############################################
server = function(input, output, session) {
observe({
if(!is.null(input$lastkeypresscode)) {
if(input$lastkeypresscode == 13){
target_pos = geocode(input$search_city, messaging =FALSE)
LAT = target_pos$lat
LONG = target_pos$lon
if (is.null(input$search_city) || input$search_city == "")
return()
output$results = renderPrint({
sprintf("Longitude: %s ---- Latitude: %s", LONG, LAT)
})
}
}
})
}
)
)
Note that for catching the ENTER input the code is 13, i.e. input$lastkeypresscode == 13.
In your case, the problem is reactive programming and this is the reason that you need something to manage this situation. My recommendation is to use observer pattern or validate function.
Observer pattern: shiny implements the observer pattern which is
useful to act when an event happens in an object (it can be a click
in a button, new value in an input...).
Validate function: the functionality of this process is similar to an
if/else statement. Indeed, there is need what is the if to check the
parameter, if the values are wrong, there will be an error message.
To know how to use observe pattern and the validate function, click on the previous link (in the Shiny website is everything explained).