R 基础图形或 ggplot 中的动画散点图是否有光泽？

Question

我一直在 Shiny 中开发一个动画滑块项目，我几乎拥有我想要的东西，但并不完全。它似乎不是显示动画序列中的每个连续图表，而是显示带有所有数据（非序列）的图表。我不太确定我的错误在哪里，但我怀疑它是在服务器部分的反应函数调用或 renderPlot 函数调用中。我试过在网上搜索，也试过在不同的位置放置不同的代码块，但我似乎无法让动画在 Shiny 中工作。最终，我想更改数字月份（1,2,3...）以使对象更清晰，但我会在动画工作后解决这个问题。

请注意 - 我已经能够使用 googleVic、gvisMotionChart 和 Shiny 成功地获得此数据的动态图表，但我发现使用这种方法我无法控制气泡图颜色或气泡大小（我想要一个常数由于重叠，尺寸远小于谷歌气泡图默认尺寸）。所以，我希望用 R 的基础图形或 ggplot 来完成这个动画。

这是代表我正在使用的一小部分数据：

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))

这是一个动画 GIF，用于显示动画在基本图形的情况下会是什么样子

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)

这是我当前的不工作闪亮代码

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))

如果有人有解决方案或想法，我将不胜感激。

Answer 1

问题是您没有保存dat 的子集。我稍微修改了您的代码以获得与 gif 动画相同的动画。

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))