Is there an elegant way to append plots to a render stack/array in Shiny instead of overwriting the existing plot? I want new plots to appear at the bottom of a page, so that the user can scroll upwards to view their previous work. Here's a starting point:
require(shiny)
server = function(input, output, session) {
observeEvent(input$execute, {
x = sort(rnorm(input$input))
output$plot = renderPlot( plot(x, type='l') )
})
}
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = NA, min = 1),
actionButton('execute', 'Go')
),
mainPanel( plotOutput('plot') )
)
shinyApp(ui, server)
Will something like this do?
require(shiny)
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = 123, min = 1),
actionButton('execute', 'Go')
),
mainPanel(tags$div(id="rowLabel",mainPanel()))
)
server = function(input, output, session) {
observeEvent(input$execute, {
insertUI(
selector = "#rowLabel",
where = "afterEnd",
ui = column(8,"Example2",plotOutput(paste0("Plot", input$execute)))
)
})
observeEvent(input$execute, {
plotname <- paste0("Plot", input$execute)
x = sort(rnorm(input$input))
output[[plotname]] = renderPlot( plot(x, type='l') )
})
}
shinyApp(ui, server)
Related
I'm trying to understand how "Progress indicators" works in shiny, so I created a loop (fictional) that takes about 7seconds (1.8GHz) to run.
I would like to show a progress bar after user clicks a button Go!
This is the code:
ui <- fluidPage(
headerPanel("Progress indicators"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50000),
br(),
actionButton("goButton", "Go!")
),
mainPanel(
verbatimTextOutput("nText")
)
)
server <- function(input, output) {
fictional <- reactive({
n=input$n
p = rep(0,n)
for(j in 1:n){
data1=rnorm(1000,1,2)
data2=runif(1000,1,2)
p[j] = min(data1,data2)
}
pw1 = mean(p)
return(pw1)
})
ntext <- eventReactive(input$goButton, { fictional()})
output$nText <- eventReactive(input$goButton, {
withProgress(message = 'Progress indicators', {
ntext()
})
})
}
shinyApp(ui, server)
I was trying to use withProgress but I don't know how to use it to wrap the codes because when I click in Go! it show me the progress bar but stops. Disappears when the loop ends
Any suggestions?
Thank you in advance!
See ?withProgress- you have to tell your progess bar the progress, e.g.
ui <- fluidPage(
headerPanel("Progress indicators"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50000),
br(),
actionButton("goButton", "Go!")
),
mainPanel(
verbatimTextOutput("nText")
)
)
server <- function(input, output) {
fictional <- reactive({
n=input$n
p = rep(0,n)
for(j in 1:n){
if (j%%100==0) incProgress(100/n)
data1=rnorm(1000,1,2)
data2=runif(1000,1,2)
p[j] = min(data1,data2)
}
pw1 = mean(p)
return(pw1)
})
ntext <- eventReactive(input$goButton, { fictional()})
output$nText <- eventReactive(input$goButton, {
withProgress(message = 'Progress indicators', {
ntext()
})
})
}
shinyApp(ui, server)
When I try to feed to uiOutput to renderUI while using tabPanel in shiny I get an error in the first run. After switching tabs, the app runs ok.
Here is a minimal example that reproduces the error
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Data",
uiOutput("moreControls")
),
tabPanel("Research",
uiOutput("moreControls2")
)
),
plotOutput("plot1")
)
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
output$plot1 <- renderPlot({
hist(rnorm(n = 100,input$mean, input$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
#Vivek's answer is nice but here is another way:
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
outputOptions(output, "moreControls2", suspendWhenHidden = FALSE)
output$plot1 <- renderPlot({
req(input$mean, input$sd)
hist(rnorm(n = 100, input$mean, input$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
The input$mean is not available before the uiOutput renders, and input$sd too, but in addition input$sd is not available until you switch to the second tab, because the sliderInput is hidden.
The reason it doesn't work is because Shiny hasn't evaluated those values when your app runs. As such, the input values aren't actually available to renderPlot()
A good way to pass in values for the plot would be to use a reactive expression. In the code below I have used plot_params() and inside the reactive, I make a list which stores the parameters of producing your plot.
I'd also recommend using shiny::validate() to ensure that the input values are valid before rendering output. (See use below)
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Data",
uiOutput("moreControls")
),
tabPanel("Research",
uiOutput("moreControls2")
)
),
plotOutput("plot1")
)
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
# Reactive expression for plot parameters.
plot_params <- reactive({
list(
mean = input$mean,
sd = input$sd
)
})
output$plot1 <- renderPlot({
validate(
need(input$mean, 'Please check that mean is set!'),
need(input$sd, 'Please check that sd is set.')
)
hist(rnorm(n = 100, plot_params()$mean, plot_params()$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
I want an event to be triggered for the first time only by clicking a button. After that I want it to be reactive to the slider input.
I tried the following:
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
activate = reactive({FALSE})
activate = eventReactive(input$go, {
isolate(TRUE)
})
samples = eventReactive(activate(), {
rnorm(input$n)
})
output$samples <- renderPlot({ hist(samples()) })
}
shinyApp(ui = ui, server = server)
I hoped it would make it reactive to input$n after input$go has been clicked once. But it isn't and still needs input$go to be clicked every time.
There are several ways to achieve that.
One way would be to store the value in a reactiveValues() or just use req(), see below.
The problem with using eventReactive(activate(), ... is that it only triggers the code inside if activate() is executed, which only happens if you click input$go.
Reproducible example with req():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
output$samples <- renderPlot({
req(input$go > 0)
hist(rnorm(input$n))
})
}
shinyApp(ui = ui, server = server)
Reproducible example with reactiveValues():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
global <- reactiveValues(showPlot = FALSE)
observeEvent(input$go, {
global$showPlot <- TRUE
})
samples = reactive({
rnorm(input$n)
})
output$samples <- renderPlot({
req(global$showPlot)
hist(samples())
})
}
shinyApp(ui = ui, server = server)
I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)
I have developed an application, where I am generating plots. I am able to render the plots and download it without any problem.
I would like to get the details of the points in the graph, when i move my cursor to the points. With search, I am not sure, if I can obtain this in Shiny.
Any help would be great.
Below is the code, i have used.
UI Code:
tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER CODE
server <- function(input,output){
output$claim_overview <- renderValueBox({
valueBox(
paste("91")," Overview",icon=icon("hourglass"),
color="green"
)
})
data<- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Prediction Probability",x="Reg.Date",y="True probability")
})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function()
{paste("input$plot3",'.png',sep='')
},
content = function(file){
ggsave(file,plot = data$plot)
}
)
}
You can use either brush option or hover option to get any info from the plot.
Mouse hover example:
df<- table(rpois(100, 5))
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "scatterplot", hover = "plot_hover"),
verbatimTextOutput(outputId = "dftable"),
br()
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
plot(df, type = "h", col = "red", lwd = 10)
})
output$dftable <- renderPrint({
paste(input$plot_hover)
})
}
shinyApp(ui = ui, server = server)