# NOT RUN {
# Only run these examples in interactive R sessions
if (interactive()) {
# A basic shiny app with a plotOutput
shinyApp(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("newplot", "New plot")
),
mainPanel(
plotOutput("plot")
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
input$newplot
# Add a little noise to the cars data
cars2 <- cars + rnorm(nrow(cars))
plot(cars2)
})
}
)
# A demonstration of clicking, hovering, and brushing
shinyApp(
ui = basicPage(
fluidRow(
column(width = 4,
plotOutput("plot", height=300,
click = "plot_click", # Equiv, to click=clickOpts(id="plot_click")
hover = hoverOpts(id = "plot_hover", delayType = "throttle"),
brush = brushOpts(id = "plot_brush")
),
h4("Clicked points"),
tableOutput("plot_clickedpoints"),
h4("Brushed points"),
tableOutput("plot_brushedpoints")
),
column(width = 4,
verbatimTextOutput("plot_clickinfo"),
verbatimTextOutput("plot_hoverinfo")
),
column(width = 4,
wellPanel(actionButton("newplot", "New plot")),
verbatimTextOutput("plot_brushinfo")
)
)
),
server = function(input, output, session) {
data <- reactive({
input$newplot
# Add a little noise to the cars data so the points move
cars + rnorm(nrow(cars))
})
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickinfo <- renderPrint({
cat("Click:\n")
str(input$plot_click)
})
output$plot_hoverinfo <- renderPrint({
cat("Hover (throttled):\n")
str(input$plot_hover)
})
output$plot_brushinfo <- renderPrint({
cat("Brush (debounced):\n")
str(input$plot_brush)
})
output$plot_clickedpoints <- renderTable({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), input$plot_click, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
output$plot_brushedpoints <- renderTable({
res <- brushedPoints(data(), input$plot_brush, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
}
)
# Demo of clicking, hovering, brushing with imageOutput
# Note that coordinates are in pixels
shinyApp(
ui = basicPage(
fluidRow(
column(width = 4,
imageOutput("image", height=300,
click = "image_click",
hover = hoverOpts(
id = "image_hover",
delay = 500,
delayType = "throttle"
),
brush = brushOpts(id = "image_brush")
)
),
column(width = 4,
verbatimTextOutput("image_clickinfo"),
verbatimTextOutput("image_hoverinfo")
),
column(width = 4,
wellPanel(actionButton("newimage", "New image")),
verbatimTextOutput("image_brushinfo")
)
)
),
server = function(input, output, session) {
output$image <- renderImage({
input$newimage
# Get width and height of image output
width <- session$clientData$output_image_width
height <- session$clientData$output_image_height
# Write to a temporary PNG file
outfile <- tempfile(fileext = ".png")
png(outfile, width=width, height=height)
plot(rnorm(200), rnorm(200))
dev.off()
# Return a list containing information about the image
list(
src = outfile,
contentType = "image/png",
width = width,
height = height,
alt = "This is alternate text"
)
})
output$image_clickinfo <- renderPrint({
cat("Click:\n")
str(input$image_click)
})
output$image_hoverinfo <- renderPrint({
cat("Hover (throttled):\n")
str(input$image_hover)
})
output$image_brushinfo <- renderPrint({
cat("Brush (debounced):\n")
str(input$image_brush)
})
}
)
}
# }
Run the code above in your browser using DataLab