在交互式闪亮图中选择范围

Question

我正在尝试以闪亮的方式创建数据的交互式可视化。可视化显示系列部分的分布（或直方图）。例如，下面的代码创建了一个系列和系列中的两个选择（两个是固定的），然后使用 ggplot 显示：

library(ggplot2)
set.seed(123)
dat <- data.frame(x = 1:1000,
                  y = cumsum(rnorm(1000, mean = 0.1)))
sel1 <- 200:400 # selection 1
sel2 <- 700:900 # Selection 2

# create a plot of the series
ggplot() + geom_line(data = dat, aes(x = x, y = y)) +
  geom_rect(aes(xmin = sel1[1], xmax = sel1[length(sel1)], 
                ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") + 
  geom_rect(aes(xmin = sel2[1], xmax = sel2[length(sel2)], 
                ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "blue")

# Histogramm preparation
# create another df that contains the selection of the two selections
pdat <- rbind(data.frame(y = dat[dat$x %in% sel1, 2],
                         sel = 1),
              data.frame(y = dat[dat$x %in% sel2, 2],
                         sel = 2))

# plot the histograms
ggplot(pdat, aes(x = y, fill = as.factor(sel))) + 
  geom_histogram(alpha = 0.5, position = "dodge")

创建：

现在我希望用户能够使用闪亮来移动这些区域（最好通过拖动图 1 中的阴影区域！）。

我玩弄了闪亮的（新）交互式选项（更多信息here，查找“交互式绘图”部分）。我想我记得有一个选项可以指定一个区域，用户可以拖动它，但我再也找不到了。

有什么想法吗？

Answer 1

正如 cmets 中提到的，请查看 rCharts 和 dygraphs，以下是从教程中获取的示例，并进行了一些修改。请注意dygraphs 需要一个时间序列对象来绘制，更多信息请参考官方docs。汇总统计可以由您选择的软件包执行。另请注意，阴影区域是用户指定的...

rm(list = ls())
library(shiny)
library(dygraphs)
library(xts)
library(rCharts)

index <- as.Date(c(seq(Sys.time(), length.out = 1000, by = "days")))
dat <- data.frame(x = index,y = cumsum(rnorm(1000, mean = 0.1)))
dat <- xts(dat[,-1], order.by=dat[,1])

ui <- fluidPage(
  titlePanel("Shaded Regions using dygraphs and rCharts by Pork Chop"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("range_one", "Range One:",min = 100, max = 1000, value = c(200,300)),
      sliderInput("range_two", "Range Two:",min = 100, max = 1000, value = c(500,600)),width=3),
    mainPanel(
      column(12,dygraphOutput("dygraph")),
      column(12,showOutput("summary", "Highcharts"))
    )
  )
)

server <- function(input, output) {

  output$dygraph <- renderDygraph({
    dygraph(dat, main = "Sample Data") %>% 
      dyShading(from = index[input$range_one[1]], to = index[input$range_one[2]], color = "#FFE6E6") %>%
      dyShading(from = index[input$range_two[1]], to = index[input$range_two[2]], color = "#CCEBD6")
  })

  output$summary <- renderChart2({

    Selection1 <- dat[input$range_one[1]:input$range_one[2]]
    Selection2 <- dat[input$range_two[1]:input$range_two[2]]    
    subset_data <- data.frame(merge(Selection1,Selection2))
    a <- rCharts:::Highcharts$new()
    a$chart(type = "column")
    a$title(text = "Summary Stats")
    a$yAxis(title = list(text = "Count"))
    a$data(subset_data)
    a$exporting(enabled=T)
    a$set(width = 1200,height = "100%",slider = TRUE)
    return(a)
  })

}

shinyApp(ui, server) 

Answer 2

我想我找到了一个能够在shiny 环境中使用交互式ggplot 的解决方案。代码如下所示：

library(shiny)
library(ggplot2)

ifna <- function(x, elseval = NA) ifelse(is.na(x) || is.null(x), elseval, x)

# two plots: as described in the question
ui <- fluidPage(
  uiOutput("plotui"),
  plotOutput("plot2")
)

server = function(input, output) {
  set.seed(123)
  dat <- data.frame(x = 1:1000,
                    val = cumsum(rnorm(1000, mean = 0.1)))
  base <- 200:400 # Base Selection

  # reactive expressions to get the values from the brushed area
  selmin <- reactive(round(ifna(input$plot_brush$xmin, elseval = 700), 0))
  selmax <- reactive(round(ifna(input$plot_brush$xmax, elseval = 900), 0))

  # include the brush option: direction = "x" says that y values are fixed (min and max)
  output$plotui <- renderUI({
    plotOutput("plot", height = 300, 
               brush = brushOpts(id = "plot_brush", direction = "x",
                                 fill = "blue", opacity = 0.5)
    )
  })

  # render the first plot including brush
  output$plot <- renderPlot({
    ggplot() + geom_line(data = dat, aes(x = x, y = val)) +
      geom_rect(aes(xmin = base[1], xmax = base[length(base)], 
                    ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") + 
      geom_rect(aes(xmin = 700, xmax = 900, 
                    ymin = -Inf, ymax = Inf), alpha = 0.1, fill = "blue") +
      ylab("Value") + xlab("t")
  })

  # render the second plot reactive to the brushed area
  output$plot2 <- renderPlot({

    # prepare the data
    pdat <- rbind(data.frame(y = dat[dat$x %in% base, "val"],
                             type = "Base"),
                  data.frame(y = dat[dat$x %in% selmin():selmax(), "val"],
                             type = "Selection"))

    ggplot(pdat, aes(x = y, fill = type)) + 
      geom_histogram(alpha = 0.5, position = "dodge") + 
      scale_fill_manual(name = "", values = c("red", "blue")) + 
      theme(legend.position = "bottom") + ylab("Frequency") + xlab("Value")
  })
}

# run the app
shinyApp(ui, server)

它给出了这样的东西（深蓝色框是交互式的，因为您可以将它推来推去，下面的图形会更新！

Picture of Shiny App