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

正如评论中所提到的，请查看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

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

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

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

2 个答案: