问题
I want something like this to happen in Shiny (but just 1 plot, not 4):
THe following steps are the ones that I want for my Shiny app plot:
- Print an empty plot
- Draw the red abline
- Sequentially draw n segments with points
- Draw blue dotted abline
- Stop
But I got 2 problems with my function that I don't know how to fix:
In the slider "n", for example if I put 10, and press "Correr", I get 8 segments first, I want none at first, and when I press the "play" button the pattern I wrote above starts.
Again, say I put 10, as soon as the blue dotted abline appears, I get an error of "subscript out of bounds"
ui:
ui <-fluidPage(
tabsetPanel(
tabPanel("Simulacion 1",
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "a",label = "a",value = 1 ,min = 1,max = 20),
sliderInput(inputId = "b",label = "b",value = 1 ,min = 1,max= 20),
sliderInput(inputId = "sig",label = "sig",value = 1 ,min = 1,max=50),
sliderInput(inputId = "n",label = "n",value = 1 ,min = 1,max=50,step=1,animate=animationOptions(interval=1000)),
actionButton(inputId= "correr", label = "Correr")),
mainPanel(plotOutput(outputId = "simul1")
)))),)
server:
server <-function(input, output) {
z=qnorm(0.975)
intercepto=c()
pendiente=c()
sim.beta=function(a,b,sig,n){
x=runif(n,1,10)
y=a+b*x+rnorm(n,0,sig)
return(data.frame(x,y))
}
Animacion=eventReactive(input$correr,{
set.seed(123)
s1=sim.beta(input$a,input$b,input$sig,input$n)
grafico=vector('list', ncol(s1))
X=s1$x;Y=s1$y
mod1=lm(s1$y~s1$x)
r11=X;r21=input$a+input$b*r11
for (i in 1:c(input$n+3)) {
if(i==1){
grafico[[i]]=ggplot(s1,aes(x,y))+
theme_classic()+
xlim(0,10)+
ylim(input$a-z*input$sig,2*input$a+input$b*10+z*input$sig)
}
if(i==2){
grafico[[i]]=grafico[[i-1]]+
geom_abline(intercept = input$a,slope = input$b,col=2)
}
else if(i>2 & i<=c(input$n+2)){
grafico[[i]]= local({
i=i
ggplot(s1[1:c(i-2),],aes(x,y))+
theme_classic()+
xlim(0,10)+
ylim(input$a-z*input$sig,2*input$a+input$b*10+z*input$sig)+
geom_abline(intercept = input$a,slope = input$b,col=2)+
geom_segment(aes(x=r11[1:c(i-2)],y=r21[1:c(i-2)]+z*input$sig,xend=r11[1:c(i-2)],yend=r21[1:c(i-2)]-z*input$sig),linetype=2)+
geom_point(aes(X[1:c(i-2)],Y[1:c(i-2)]),col=3,size=3)
})
}
else if(i==c(input$n+3)){
grafico[[i]]= grafico[[i-1]]+
geom_abline(aes(intercept=mod1$coefficients[1],slope=mod1$coefficients[2]),col=4,linetype=2)
}
}
grafico
})
output$simul1 <- renderPlot({
Animacion()[[input$n]]
}, height = 650, width = 650)
}
shinyApp(ui = ui, server = server)
回答1:
Here is a working solution. I've made a few changes:
animacionis now only dependent on areactiveTimer. This allows you to generate new plot data in a given intervalanimaciononly returns one plot, which is then plotted -> you don't need to mess around withinput$nwhich plot should be shown- I've added some logic to introduce a timer counter/index, so that the correct output data is sequentially generated
- because the parameter change should only applied when "Correr" is pressed, I've added a new
eventReactiveto store the parameters (otherwise the updated values would be automatically used every time the timer triggers)
library(shiny)
library(ggplot2)
ui <-fluidPage(
tabsetPanel(
tabPanel("Simulacion 1",
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "a",label = "a",value = 1 ,min = 1,max = 20),
sliderInput(inputId = "b",label = "b",value = 1 ,min = 1,max= 20),
sliderInput(inputId = "sig",label = "sig",value = 1 ,min = 1,max=50),
sliderInput(inputId = "n",label = "n",value = 1 ,min = 1,max=50,step=1,animate=animationOptions(interval=1000)),
actionButton(inputId= "correr", label = "Correr")),
mainPanel(plotOutput(outputId = "simul1")
)))))
server <-function(input, output) {
z=qnorm(0.975)
intercepto=c()
pendiente=c()
animation_timer <- reactiveTimer(1500)
timer_index <- 1
grafico <- list()
sim.beta=function(a,b,sig,n){
x=runif(n,1,10)
y=a+b*x+rnorm(n,0,sig)
return(data.frame(x,y))
}
animation_parameters <- eventReactive(input$correr, {
list(a = input$a,
b = input$b,
sig = input$sig,
n = input$n)
})
Animacion = eventReactive(animation_timer(),{
set.seed(123)
s1=sim.beta(animation_parameters()$a,
animation_parameters()$b,
animation_parameters()$sig,
animation_parameters()$n)
X=s1$x;Y=s1$y
mod1=lm(s1$y~s1$x)
r11=X;r21=input$a+input$b*r11
if(timer_index ==1){
grafico <<- ggplot(s1,aes(x,y))+
theme_classic()+
xlim(0,10)+
ylim(animation_parameters()$a-z*animation_parameters()$sig,2*animation_parameters()$a+animation_parameters()$b*10+z*animation_parameters()$sig)
}
if(timer_index ==2){
grafico <<- grafico +
geom_abline(intercept = animation_parameters()$a,slope = animation_parameters()$b,col=2)
}
else if(timer_index>2 & timer_index<=c(animation_parameters()$n+2)){
grafico <<- local({
i= timer_index
ggplot(s1[1:c(i-2),],aes(x,y))+
theme_classic()+
xlim(0,10)+
ylim(animation_parameters()$a-z*animation_parameters()$sig,2*animation_parameters()$a+animation_parameters()$b*10+z*animation_parameters()$sig)+
geom_abline(intercept = animation_parameters()$a,slope = animation_parameters()$b,col=2)+
geom_segment(aes(x=r11[1:c(i-2)],y=r21[1:c(i-2)]+z*animation_parameters()$sig,xend=r11[1:c(i-2)],yend=r21[1:c(i-2)]-z*animation_parameters()$sig),linetype=2)+
geom_point(aes(X[1:c(i-2)],Y[1:c(i-2)]),col=3,size=3)
})
}
else if(timer_index ==c(animation_parameters()$n+3)){
grafico <<- grafico +
geom_abline(aes(intercept=mod1$coefficients[1],slope=mod1$coefficients[2]),col=4,linetype=2)
}
# update timer_index
if (timer_index == animation_parameters()$n + 3) {
timer_index <<- 1
} else {
timer_index <<- timer_index + 1
}
grafico
})
output$simul1 <- renderPlot({
Animacion()
}, height = 650, width = 650)
}
shinyApp(ui = ui, server = server)
P.S. I'm actually not sure if local and animation_parameters work together, maybe you have to tweak that.
来源：https://stackoverflow.com/questions/63636698/how-to-print-a-list-of-ggplots-in-shiny-in-a-for-loop