I need an interactive plot with two sliders, and I want the plot to be updated smoothly as I slide, without releasing mouse button. Do you know of any other solution in R which is able to do that?
I found a nice library manipulate (see example below), but the plot is only updated after releasing mouse button, so I have to stop sliding to see updated plot (which makes the experience not smooth). I want the plot to be updated during sliding already.
library(manipulate)
manipulate(curve(amp*sin(freq*x), xlim = c(0,10), ylim =c(-1,1)), amp = slider(0.1,1), freq = slider(0.1,10))
PS: I am used to just base graphics library, so I prefer simple solutions using that; but if there's no other way, ggplot/lattice is good as well :-))
I appreciate you were looking for a answer in base R, however shiny is typically a good choice for interactive plots in R.
The following code should achieve your desired output (and you do not have to release the mouse button for the plot to update):
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "amp",
label = "Amp:",
min = 0.1,
max = 1,
value = 0.5
),
sliderInput(
inputId = "freq",
label = "Freq:",
min = 0.1,
max = 10,
value = 0.5
)
),
# Show a plot
mainPanel(
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
output$plot <- renderPlot({
amp <- input$amp
freq <- input$freq
curve(amp * sin(freq * x), xlim = c(0, 10), ylim = c(-1, 1))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
The transitions of my Shiny app are very long when I change a numericInput value by clicking on the button "quickly" several times in a row .
How can I stop the previous code from running once a new numericInput has changed ? I don't know if I explained my problem clearly. Is it possible to put a GIF in a StackOverflow post ?
Try to play with the button to understand my problem
# USER INTERFACE
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput("sd", p("sd"), value = 0.1, step = 0.1)),
mainPanel(plotOutput("plot"))
)
)
# SERVER
server <- function(input, output) {
output$plot<- renderPlot({
x <- seq(-1, 1, length.out = 50000)
plot(x, x + rnorm(50000, sd = input$sd), ylab = "y")
})
}
shinyApp(ui = ui, server = server)
You can’t cancel a computation once it’s started without setting up some sort
of subprocess processing. However, even that would not help in this case,
because the time-consuming operation is the actual graphics rendering. You’d
need a custom equivalent to renderPlot() to handle that.
Likely the best you can do here is to debounce() the input, so that you
won’t start plotting until the input value has settled for some amount of time:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput("sd", p("sd"), value = 0.1, step = 0.1)),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output) {
input_sd <- debounce(reactive(input$sd), 400)
output$plot <- renderPlot({
x <- seq(-1, 1, length.out = 50000)
plot(x, x + rnorm(50000, sd = input_sd()), ylab = "y")
})
}
shinyApp(ui = ui, server = server)
Or if changing inputs too quickly is still a problem even when debounced, accept that and use a submit button to explicitly trigger the plotting.
I've made a cool Shiny app that allows users to resize their plot and move it around on the canvas.
The problem is, sometimes the downloaded plot looks very different from what is displayed in the view panel - it comes out as a square graphic that might have the plot cut off if as you change the scale and positioning.
If you draw it at 0.5 scale it looks the same in browser and in the downloaded png. -- But if you make it to scale 0.8, or even simply scale 1.0, it'll look perfect in the view panel but ugly and misaligned when printed with ggsave().
Perhaps this is a question about adjusting parameters to ggsave? Or is it that my background image is sized strangely (1920 x 1028 pixels)? Or perhaps the reactive panel throws it off somehow...? I'm confused at this point.
Anyway I drew a grey background behind the plot area so that you can easy tell the canvas from the panel.
And here is a minimal reproducible example.
library(shiny)
library(tidyverse)
library(magick)
library(cowplot)
picture <- 'https://content.halocdn.com/media/Default/games/halo-5-guardians/map-images/arena/arena_maps_sustain_array04-bddc574f8e3445d08f24ef859fb96941.jpg'
background <- image_read(picture)
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
sliderInput("xposition",
"X-Axis Position",
min = -1,
max = 1,
value = 0,
step = 0.1),
sliderInput("yposition",
"Y-Axis Position",
min = -1,
max = 1,
value = 0,
step = 0.1),
sliderInput("scale",
"Chart Scale",
min = .25,
max = 1,
value = .5,
step = 0.1)),
# Show a plot over grey background to see how canvas shifts
mainPanel(style = "background:grey",
plotOutput("distPlot"),
downloadButton("downloadPlot", "Download")
)
)
)
server <- function(input, output) {
xposition <- reactive({input$xposition})
yposition <- reactive({input$yposition})
scale <- reactive({input$scale})
plot <- reactive({
base_plot <- ggplot(faithful, aes(x = waiting), bins = input$bin) +
geom_histogram()
ggdraw() +
draw_image(background) +
draw_plot(base_plot, x = xposition(), y = yposition(), scale = scale())
})
## Use Cowplot package to alter scale and position
output$distPlot <- renderPlot({
# draw the histogram with the specified number of bins
plot()
})
output$downloadPlot <- downloadHandler(
filename = "my_awesome_plot.png",
content = function(file) {
ggsave(file, plot())
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
If you try scale 0.5, scale 0.8, and scale 1.0, you'll see what I mean!
Any help????
Note: The reproducible example above should be enough to find the problem, but if you want to see a more "in depth" example here is my real app which has more images in it and more reactive scalings and positionings.
https://jjohn987.shinyapps.io/Halo5_Stats/
Type in a player's tag name (e.g., these work => hi, k, hairball9000, or other gamer tags people use, but no commas or spaces) and you'll see that what appears to be "the bottom" of the plot is very different than what the bottom is in the download... Keep in mind I haven't applied for any significant api bandwidth from Microsoft so the calls might get timed out depending on how many people try to help!
I have a problem regarding shiny and the use of sliders, when displaying chart_Series and coloured lines . When I am using the slider from the right side, the color is chosen appropriately (mainly red dots). When I use the slider on left side (e.g. looking at the latest data) the color is not chosen appropriately (should be green). I seek for help and I'm thankful for any advise!
require(quantmod)
require(shiny)
getSymbols("YHOO")
data <- YHOO
data <- data[1:100,]
col_function <- rep("red",50)
col_function <- c(col_function, rep("green",50))
plot <- {
date_range <- index(data)
if (interactive()) {
options(device.ask.default = FALSE)
# Define UI
ui <- fluidPage(
titlePanel("Time:"),
sidebarLayout(
# Sidebar with a slider input
wellPanel(
tags$style(type="text/css", '#leftSlide { width:200px; float:left;}'),
id = "leftSlide",
sliderInput("Range", "Choose Date Range:",
min = first(date_range), max = last(date_range), value = c(first(date_range),last(date_range)))
),
mainPanel(
plotOutput("Plot", width = "150%", height = "500px")
)
)
)
# Server logic
server <- function(input, output) {
output$range <- renderPrint({ input$slider2 })
output$Plot <- renderPlot({
x_ti2 <- xts(rep(1, NROW(data)), order.by = index(data))
x_ti2[1, ] <- 0.5
chart_Series(data)
add_TA(x_ti2, col = col_function, pch = 9, type = 'p', cex = .7)
# Another way below, but the color function is still not working
#chart_Series(data["2017"], TA = 'add_TA(x_ti, col = col_function, pch = 15, type = "p", cex = .7); add_TA(x_ti2, col = "orange", pch = 9, type = "p", cex = .7)')
zoom_Chart(paste(input$Range, collapse = "::"))
})
observe({
print(input$Range)
})
}
shinyApp(ui, server)
}
}
plot
So, I found a workaround for my own problem:
as far as i can tell, shiny will edit the data, but not the coloring-vector (in respective pretty logical...). Therefore you'll have to tell shiny to update the range of the coloring as well.
First of all i transformed the coloring result to an xps-object. Then i added the x_ti2-variable to the original data-matrix and defined a variable with the input$range for your the col_function. The variable needs to part of the Global environment (such that shiny can use it). I hope this will solve some issues, if someone has a similiar problem.
I've been working on an animated slider project in Shiny and I nearly have what I am after, but not quite. Instead of displaying each successive graph in the animated sequence, it appears to be showing the graph with all of the data (non sequenced). I'm not quite sure where my error is but I suspect it is in the reactive function call or the renderPlot function call in the server section. I've tried searching the Web and I've tried placing different code blocks in different locations but I can not seem to get the animation to work in Shiny. Eventually I want to change the numeric months (1,2,3...) to date objects for more clarity but I'll tackle that one after the animation is working.
Please note - I HAVE been able to get a successful motion chart for this data using googleVic, gvisMotionChart and Shiny but I found with that approach I do not have control of the bubble chart colors or the bubble size (I want a constant size that is much smaller than google's bubble chart default size due to overlap). So, I am hoping to accomplish this animation with R's base graphics or with ggplot.
Here is small set of data to represent what I am using:
d1 <- data.table( id = 1:21,
Region = rep(c("R1","R2","R3"), each=7),
Month = 1,
Spend = round(runif(21,100,500)),
Age = round(runif(21,72,100)),
Color = rep(c("#E69F00","#D55E00","#009E73"),each=7))
d2 <- copy(d1)
d2[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d3 <- copy(d2)
d3[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d4 <- copy(d3)
d4[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d5 <- copy(d4)
d5[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d6 <- copy(d5)
d6[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d7 <- copy(d6)
d7[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d8 <- copy(d7)
d8[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
dat <- rbindlist(list(d1,d2,d3,d4,d5,d6,d7,d8))
Here is an animated GIF to show what the animation would look like with base graphics
saveGIF({
for(i in 1:8){
plot(dat[Month==i,Age],dat[Month==i,Spend],col=dat[Month==i,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),
cex=.8)
ani.pause()
}
}, interval = 0.25, ani.width = 750, ani.height = 550)
This is my current nonworking Shiny code
library(shiny)
library(ggplot2)
# Shiny app with slider and animation
# ui section
ui = fluidPage(
# Title
titlePanel("Spend vs Age by Region"),
# Sidebar with slider and controls for animation
sidebarLayout(
# sidebar with slider
sidebarPanel(
# Slider with looping
sliderInput("theMonth", "Month", 1, 8, 1, step = 1,
animate=animationOptions(interval=1000, loop = T,
playButton = T, pauseButton = T))
),
# Show the animated graph
mainPanel(
plotOutput(outputId="case_age_plot")
)
)
)
# server section
server = function(input, output) {
# Reactive expression to create data frame and graph
aniGraph <- reactive({
# subset the data frame into the portion that has the data for the
# graph in the animation sequence
dat[Month==input$theMonth,]
# create the graph
plot(dat[,Age],dat[,Spend],col=dat[,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),cex=.8)
})
# Show the graph
output$case_age_plot <- renderPlot({
aniGraph()
})
}
# run the app
runApp(list(ui = ui, server = server))
If anyone has a solution or thoughts I would be grateful.
the problem was that you didn't save the subset of dat. I slightly modified your code to get the same animation as in gif animation.
library(shiny)
library(ggplot2)
# Shiny app with slider and animation
# ui section
ui = fluidPage(
# Title
titlePanel("Spend vs Age by Region"),
# Sidebar with slider and controls for animation
sidebarLayout(
# sidebar with slider
sidebarPanel(
# Slider with looping
sliderInput("theMonth", "Month", 1, 8, 1, step = 1,
animate=animationOptions(interval=1000, loop = T,
playButton = T, pauseButton = T))
),
# Show the animated graph
mainPanel(
plotOutput(outputId="case_age_plot")
)
)
)
# server section
server = function(input, output) {
# Reactive expression to create data frame and graph
aniGraph <- reactive({
# subset the data frame into the portion that has the data for the
# graph in the animation sequence
# Save subset of 'dat' and pass it to the plot
dat_sub <- dat[Month==input$theMonth,]
# create the graph
plot(dat_sub[,Age],dat_sub[,Spend],col=dat_sub[,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),cex=.8)
})
# Show the graph
output$case_age_plot <- renderPlot({
aniGraph()
})
}
# run the app
runApp(list(ui = ui, server = server))
I wanted my graph to just animate without a slider. With a duckduck search I found Dan Mohamed's article at https://nhsrcommunity.com/animating-a-graph-over-time-in-shiny/ which pointed me to reactiveTimer(). Here is a condensed version of my implementation.
propagator <- 0
ui <- fluidPage( . . . )
server <- function(input, output) {
autoInvalidate <- reactiveTimer()
observe( {autoInvalidate()} )
output$orb <- renderPlot({
autoInvalidate()
propagator <<- propagator + 1
. . .
})
}
I have used shiny for several small scale project and am now giving a try to the shinydashboard package which looks rather promising. I also want to integrate interactive plot using plotly (although other libraries can be considered in the future).
I have no problem running examples integrating plotly in shiny (example) but face problems when attempting to achieve a similar results with shinydashboard.
For example, the code below (app.R) is not working properly.
library(shiny)
library(shinydashboard)
library(plotly)
library(ggplot2)
data(movies, package = "ggplot2")
minx <- min(movies$rating)
maxx <- max(movies$rating)
#######
####### UI
#######
ui <- dashboardPage(
############# Header
dashboardHeader(title = "Test"),
############# Sidebar
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
),
############# Dashboard body
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1"), width=6, height=500),
box(plotOutput("plot2"), width=6, height=500)
)
)
)
#######
####### Server
#######
server <- function(input, output, session) {
output$plot1 <- renderPlot({
# a simple histogram of movie ratings
p <- plot_ly(movies, x = rating, autobinx = F, type = "histogram",
xbins = list(start = minx, end = maxx, size = 2))
# style the xaxis
layout(p, xaxis = list(title = "Ratings", range = c(minx, maxx), autorange = F,
autotick = F, tick0 = minx, dtick = 2))
})
output$plot2 <- renderPlot({
hist(movies$rating, col="blue")
})
}
shinyApp(ui, server)
The page is supposed to display two similar plots: one generated with plotly, the other with R base. The second one is displayed properly but the plotly one is displayed in Rstudio viewer panel. If I run the App on a terminal using the runApp() function, one webpage opens for the dashboard and another one using only for the plotly interactive plot.
I have tried to create some reactive plots (plots change in function of the content of some shiny controls such as slide bars) and the plot opened either in the viewer or another browser window/tab is updated.
So everything seems to work, the only problem is that the plotly plot is not inserted in the dashboard but in a different location (viewer or other tab), which, of course, is a problem.
Despite of my research, I could not find a solution to the problem (or even people mentioning it...). Any clue?
Check again the tutorial carefully, I think you need to replace in the ui
box(plotOutput("plot1"), width=6, height=500)
by
box(plotlyOutput("plot1"), width=6, height=500)
And in the server just replace
output$plot1 <- renderPlot({
......
by
output$plot1 <- renderPlotly({
....