2

我在 ggplot2 中创建了一个时间序列图,该图将转到 shinydashbaord 的面板。我需要底部面板作为时间序列图的缩放图。出于某种原因,我的缩放图没有显示时间序列图中的数据或轴值。非常感谢这里的任何帮助。

下面的示例使用在边栏中设置的日期范围。如果在此示例中更改了日期范围,则绘图将不起作用。我的实际工作对日期并不那么敏感,这只是为了演示。

library (shiny)
library (shinydashboard)
library (ggplot2)

header <- dashboardHeader(title = "Example")

sidebar <- dashboardSidebar(
 sidebarMenu(
   menuItem("Data Estimation", tabName = "tabset1",
      dateRangeInput("dates", 
                    "Date range for regression",
                    start = as.character(Sys.Date() - 495), 
                    end = as.character(Sys.Date() - 396))
)))

body <- dashboardBody(
 fluidRow(
  tabBox(id = "tabset1", height = "450px", width = "900px",
   tabPanel("Time Series Est", 
     plotOutput ("plot1", height = 400,
                 brush = brushOpts(
                   id = "plot1Brush",
                   resetOnNew = TRUE)))
)),
 fluidRow(
  tabBox(id = "tabset1", height = "450px", width = "900px",
   tabPanel("Zoom", 
     plotOutput ("plot2", height = 400)
))))

ui <- dashboardPage(skin = "blue", header, sidebar, body)

server <- function(input, output) ({

output$plot1 <- renderPlot({

dat <- data.frame(x = seq(1,100,1), y = seq(1,2000,20), z = seq(1,3000,30), dateTime = seq(input$dates[1], input$dates[2], 1))

p <- ggplot() +
 geom_line(data = dat, aes(x = dateTime, y = x, color = "x")) +
 geom_line(data = dat, aes(x = dateTime, y = y, color = "y")) +
 geom_line(data = dat, aes(x = dateTime, y = z, color = "z")) +
 scale_y_log10() +
 theme_bw()

print(p)

})

ranges2 <- reactiveValues(x = NULL, y = NULL)

observe({
 brush <- input$plot1Brush
 if (!is.null(brush)) {
  ranges2$x <- c(brush$xmin, brush$xmax)
  ranges2$y <- c(brush$ymin, brush$ymax)
}
else {
 ranges2$x <- NULL
 ranges2$y <- NULL
}
})


output$plot2 <- renderPlot({

if (!is.null(ranges2$x)) {
ranges2$x <- as.Date(ranges2$x, origin = "1970-01-01")
}

dat <- data.frame(x = seq(1,100,1), y = seq(1,2000,20), z = seq(1,3000,30), dateTime = seq(input$dates[1], input$dates[2], 1))

p <- ggplot() +
 geom_line(data = dat, aes(x = dateTime, y = x, color = "x")) +
 geom_line(data = dat, aes(x = dateTime, y = y, color = "y")) +
 geom_line(data = dat, aes(x = dateTime, y = z, color = "z")) +
 coord_cartesian(xlim = ranges2$x, ylim = ranges2$y) +
 scale_y_log10() +
 theme_bw()

print(p)

})

})

shinyApp(ui, server)
4

2 回答 2

2

在您的 renderPlot() 表达式中,而不是使用print(p),替换为p

它对我有用。

于 2016-01-08T21:41:11.803 回答
0

您的数据序列向量的长度不同。

用以下内容替换您的数据框定义(两者):

n <- 100
dat <- data.frame(x = seq(1,to=100,length.out=n), 
                  y = seq(1,to=2000,length.out=n), 
                  z = seq(1,to=3000,length.out=n), 
                  dateTime = seq(input$dates[1], to=input$dates[2],length.out=n)) 

我对此进行了测试,效果很好。当我更改日期并且绘图为空白时,它出错并发出空白图之前。我相信哪个是问题?

这是完整的代码:

library (shiny)
library (shinydashboard)
library (ggplot2)

header <- dashboardHeader(title = "Example")

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Data Estimation", tabName = "tabset1",
             dateRangeInput("dates", 
                            "Date range for regression",
                            start = as.character(Sys.Date() - 495), 
                            end = as.character(Sys.Date() - 396))
    )))

body <- dashboardBody(
  fluidRow(
    tabBox(id = "tabset1", height = "450px", width = "900px",
           tabPanel("Time Series Est", 
                    plotOutput ("plot1", height = 400,
                                brush = brushOpts(
                                  id = "plot1Brush",
                                  resetOnNew = TRUE)))
    )),
  fluidRow(
    tabBox(id = "tabset1", height = "450px", width = "900px",
           tabPanel("Zoom", 
                    plotOutput ("plot2", height = 400)
           ))))

ui <- dashboardPage(skin = "blue", header, sidebar, body)

server <- function(input, output) ({

  output$plot1 <- renderPlot({

   # dat <- data.frame(x = seq(1,100,1), y = seq(1,2000,20), z = seq(1,3000,30), dateTime = seq(input$dates[1], input$dates[2], 1))
    n <- 100
    dat <- data.frame(x = seq(1,to=100,length.out=n), 
                      y = seq(1,to=2000,length.out=n), 
                      z = seq(1,to=3000,length.out=n), 
                      dateTime = seq(input$dates[1], to=input$dates[2],length.out=n))   
    p <- ggplot() +
      geom_line(data = dat, aes(x = dateTime, y = x, color = "x")) +
      geom_line(data = dat, aes(x = dateTime, y = y, color = "y")) +
      geom_line(data = dat, aes(x = dateTime, y = z, color = "z")) +
      scale_y_log10() +
      theme_bw()
    p

  })

  ranges2 <- reactiveValues(x = NULL, y = NULL)

  observe({
    brush <- input$plot1Brush
    if (!is.null(brush)) {
      ranges2$x <- c(brush$xmin, brush$xmax)
      ranges2$y <- c(brush$ymin, brush$ymax)
    }
    else {
      ranges2$x <- NULL
      ranges2$y <- NULL
    }
  })


  output$plot2 <- renderPlot({

    if (!is.null(ranges2$x)) {
      ranges2$x <- as.Date(ranges2$x, origin = "1970-01-01")
    }
    n <- 100
    dat <- data.frame(x = seq(1,to=100,length.out=n), 
                      y = seq(1,to=2000,length.out=n), 
                      z = seq(1,to=3000,length.out=n), 
                      dateTime = seq(input$dates[1], to=input$dates[2],length.out=n))

    p <- ggplot() +
      geom_line(data = dat, aes(x = dateTime, y = x, color = "x")) +
      geom_line(data = dat, aes(x = dateTime, y = y, color = "y")) +
      geom_line(data = dat, aes(x = dateTime, y = z, color = "z")) +
      coord_cartesian(xlim = ranges2$x, ylim = ranges2$y) +
      scale_y_log10() +
      theme_bw()

    p

  })

})

shinyApp(ui, server)

在此处输入图像描述

于 2016-01-08T21:39:32.080 回答