I'm interested in having a default selection for a shiny app that changes each time you refresh the page. So for example, in the hello world Shiny demo, instead of having the default selection be 500, I would like it to be sample(1:1000,1)
http://shiny.rstudio.com/gallery/example-01-hello.html
I've tried putting a randomly generated value directly in the value = part, but that seems to only be updated each time the app is started, not each time the page is loaded.
How can I go about having a random default?
We can use updateSliderInput, e.g
server <- function(input, output, session) {
observe({
updateSliderInput(session, "bins", value = sample(1:500,1))
})
....
}
Don't forget to add session variable to the server function definition and update max value in sliderInput to 500.
You need to use a reactive UI element.
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Hello Shiny!"),
# Sidebar with a slider input for number of observations
sidebarLayout(
sidebarPanel(
uiOutput("slider")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
# Expression that generates a plot of the distribution. The expression
# is wrapped in a call to renderPlot to indicate that:
#
# 1) It is "reactive" and therefore should be automatically
# re-executed when inputs change
# 2) Its output type is a plot
#
output$slider <- renderUI({
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value =runif(1,1,1000))
})
output$distPlot <- renderPlot({
req(input$obs)
# generate an rnorm distribution and plot it
dist <- rnorm(input$obs)
hist(dist)
})
}
shinyApp(ui = ui, server = server)
This will randomly select a new value in the slider. Is this what you were after?
Related
Is there any possibility to update an input without reactives getting triggered?
Below I put a minimal example. The aim is to update the slider without the value in the main panel changing. When the slider is changed again, then it should be forwarded to dependent reactives again.
The question and the underlying use case is similiar to the following questions: R shiny - possible issue with update***Input and reactivity and Update SelectInput without trigger reactive?. Similiar to these questions, there is a reactive that depends on two Inputs in my use case. I want to update one of these input depending on the other, which results in the reactive getting calculated twice. However, both of these questions got around the problem by updating the input only selectively. This is not possible in my use case, since I want to have some information shown to the user by updating the input.
If there is no possibility to update an input without reactives getting triggered, I will ask a follow-up-question focusing on my use case.
Example
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText(input$bins)
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
isolate(
updateSliderInput(session,"bins",value=20 )
)
})
}
shinyApp(ui = ui, server = server)
Here's a stab, though it feels like there might be side-effects from using stale data. Using the following diff:
# Define server logic
server <- function(input, output, session) {
- output$sliderValue <- renderText(input$bins)
+ output$sliderValue <- renderText({ saved_bins(); })
+ update <- reactiveVal(TRUE)
+ saved_bins <- reactiveVal(30)
+
+ observeEvent(input$bins, {
+ if (update()) saved_bins(input$bins) else update(TRUE)
+ })
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
+ update(FALSE)
- isolate(
updateSliderInput(session,"bins",value=20 )
- )
})
}
The method: using two new reactive values, one to store the data that (saved_bins) is used in the rendering, and one (update) to store whether that data should be updated. Everything that depends on input$bins should instead depend on saved_bins(). By using an additional observeEvent, the reactivity will always cascade as originally desired except when you explicitly set a one-time "do not cascade" with the prepended update(FALSE).
Full code below:
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
update <- reactiveVal(TRUE)
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update()) saved_bins(input$bins) else update(TRUE)
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update(FALSE)
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)
Firstly credit to #r2evans's solution.
At the risk of a verbal thrashing from the many headteacheRs that prohibit it, to avoid double observer you can use global assignment. Sensible to use a less generic name than 'update' though.
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update) saved_bins(input$bins) else update <<- TRUE
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update <<- FALSE
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)
This is my first attempt at creating a Shiny app so I wanted to do something very simple: use fileInput so the user can select an image on their computer and then renderImage to plot the image.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("plot image"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("image",
"Select your image:", placeholder = "No file selected")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("photo")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$photo <- renderImage({
img <- load.image(input$image)
plot(img)
})
}
# Run the application
shinyApp(ui = ui, server = server)
However, when I try to load an image with this I get an error: invalid filename argument.
Ultimately I would like to integrate selectInput the choices option would have a few default images as well as those the user uploaded with fileInput but I feel that I'm already getting ahead of myself on that.
UPDATE 1:
library(shiny)
library(ggplot2)
library(imager)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("plot images"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("image",
"Select your image:", placeholder = "No file selected")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("photo")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$photo <- renderPlot({
# Ensure the values for 'image' are available
# If not, the operation is stopped by raising a "silent" exception
req(input$image)
# Get edges of image with imager::cannyEdges
img <- cannyEdges(input$image)
# img is now a logical array with 4 dimensions but we only want 2 - discard two of the dimensions
img <- img[, , 1, 1]
# Convert the matrix into a list of coordinates
coords <- which(img, arr.ind = T)
# Turn the coordinates into a dataframe
df <- data.frame(x = coords[, 1], y = coords[, 2])
# Plot the coordinates
ggplot(df, aes(x, -y)) +
geom_point()
})
}
# Run the application
shinyApp(ui = ui, server = server)
See ?fileInput. If "image" is the id, then the path to the uploaded file is input$image$datapath, not input$image.
So you can do something like:
output$photo <- renderImage({
req(input$image)
list(src = input$image$datapath, alt="alternative text")
})
and in ui,
imageOutput("photo")
I encountered the same issue and solved. the image can't be loaded is because the input$image doesn't just give the filename you want, but also give more information. That make it a named list rather than a single value. Maybe you can try as following in your first case.
server <- function(input, output) {
output$photo <- renderImage({
img <- load.image(input$image[[4]])
plot(img)
})
}
Hope it works.
I would like to figure out, which feature of my shiny app is used most...
What is the preferred way on doing this?
At the moment I parse the shiny server access.log and could find some links like
.../session/69d4f32b3abc77e71097ae4beefbd135/dataobj/lifecycle_table which indicates when a DT object called lifecycle_table is loaded. But I can only see this for these DT objects.
Are there better ways?
Would love to create this statistics per unique IP. Basically which tabs are clicked. I am not interested in the search strings etc.
Edit: For getting info about the clicked tabs have a look in: ?tabsetPanel
You see that you can specify an id for the panel.
So tabsetPanel(id="tabs",...) will enable you to track the selected tabpanel on the server side with input$tabs.
See an example below: (based on https://shiny.rstudio.com/articles/tabsets.html)
library(shiny)
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("Tabsets"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the br()
# element to introduce extra vertical spacing
sidebarPanel(
radioButtons("dist", "Distribution type:",
list("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
br(),
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000)
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Visited Tabs", tableOutput("table"))
)
)
))
# Define server logic for random distribution application
server <- shinyServer(function(input, output, session) {
global <- reactiveValues(visitedTabs = c())
# Reactive expression to generate the requested distribution. This is
# called whenever the inputs change. The renderers defined
# below then all use the value computed from this expression
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
observe({
input$tabs
isolate({
userTabInfo <- paste0(" selected: ",input$tabs)
print(userTabInfo)
global$visitedTabs = c(global$visitedTabs, userTabInfo)
})
})
# Generate a plot of the data. Also uses the inputs to build the
# plot label. Note that the dependencies on both the inputs and
# the 'data' reactive expression are both tracked, and all expressions
# are called in the sequence implied by the dependency graph
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main=paste('r', dist, '(', n, ')', sep=''))
})
# Generate a summary of the data
output$summary <- renderPrint({
str(session$userData)
# session$user
})
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(global$visitedTabs)
})
})
shinyApp(ui, server)
Concerning the IP: I know about 4-5 code snippets to get the IP and they all use JSS or XSS-style how you call it :) I agree it should be somehow possible, but since people already asked 3-4 years ago, I am not sure its really a matter of awareness from the shiny team. Hope the tab tracking helps anyway. If you like I can add the JS snippet to get the IP again.
I understand that reactive values notifies any reactive functions that depend on that value as per the description here
based on this I wanted to make use of this property and create a for loop that assigns different values to my reactive values object, and in turn I am expecting another reactive function to re-execute itself as the reactive values are changing inside the for loop. Below is a simplified example of what i am trying to do:
This is the ui.R
library(shiny)
# Define UI
shinyUI(pageWithSidebar(
titlePanel("" ,"For loop with reactive values"),
# Application title
headerPanel(h5(textOutput("Dummy Example"))),
sidebarLayout(
#Sidebar
sidebarPanel(
textInput("URLtext", "Enter csv of urls", value = "", width = NULL, placeholder = "Input csv here"),
br()
),
# Main Panel
mainPanel(
h3(textOutput("caption"))
)
)
))
This is the server file:
library(shiny)
shinyServer(function(input, output) {
values = reactiveValues(a = character())
reactive({
url_df = read.table(input$URLtext)
for (i in 1:5){
values$a = as.character(url_df[i,1])
Sys.sleep(1)
}
})
output$caption <- renderText(values$a)
})
This does not give the expected result. Actually when I checked the content of values$a
it was null. Please help!
Rather than using a for loop, try using invalidateLater() with a step counter. Here's a working example that runs for me with an example csv found with a quick google search (first column is row index 1-100).
library(shiny)
# OP's ui code
ui <- pageWithSidebar(
titlePanel("" ,"For loop with reactive values"),
headerPanel(h5(textOutput("Dummy Example"))),
sidebarLayout(
sidebarPanel(
textInput("URLtext", "Enter csv of urls", value = "", width = NULL, placeholder = "Input csv here"),
br()
),
mainPanel(
h3(textOutput("caption"))
)
)
)
server <- function(input, output, session) {
# Index to count to count through rows
values = reactiveValues(idx = 0)
# Create a reactive data_frame to read in data from URL
url_df <- reactive({
url_df <- read.csv(input$URLtext)
})
# Reset counter (and url_df above) if the URL changes
observeEvent(input$URLtext, {values$idx = 0})
# Render output
output$caption <- renderText({
# If we have an input$URLtext
if (nchar(req(input$URLtext)) > 5) {
# Issue invalidation command and step values$idx
if (isolate(values$idx < nrow(url_df()))) {
invalidateLater(0, session)
isolate(values$idx <- values$idx + 1)
}
}
# Sleep 0.5-s, so OP can see what this is doing
Sys.sleep(0.5)
# Return row values$idx of column 1 of url_df
as.character(url_df()[values$idx, 1])
})
}
shinyApp(ui = ui, server = server)
Quick question on conditionalPanel for shiny/R.
Using a slightly modified code example from RStudio, consider the following simple shiny app:
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "input.n > 20",
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
My objective is to hide the graph and move up the HTML text to avoid a gap. Now, you can see that if the entered value is below 20, the graph is hidden and the text "Bottom" is moved up accordingly. However, if the entered value is larger than 20, but smaller than 50, the chart function returns NULL, and while no chart is shown, the text "Bottom" is not moving up.
Question is: is there a way I can set a conditionalPanel such that it appears/is hidden based on whether or not a plot function returns NULL? The reason I'm asking is because the trigger a bit complex (among other things it depends on the selection of input files, and thus needs to change if a different file is loaded), and I'd like to avoid having to code it on the ui.R file.
Any suggestions welcome,
Philipp
Hi you can create a condition for conditionalPanel in the server like this :
n <- 200
library("shiny")
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "output.cond == true", # here use the condition defined in the server
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output, session) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
# create a condition you use in the ui
output$cond <- reactive({
input$n > 50
})
outputOptions(output, "cond", suspendWhenHidden = FALSE)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Don't forget to add the session in your server function and the outputOptions call somewhere in that function.