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

R基本图形或ggplot中的动画散点图有光泽吗？

1 个答案: