logo标签列表

使用ggvis展示纵向数据，其中滑块控制年份。

rshinyggvis
4

我希望使用滑块来控制纵向空间数据集中的年份，这本质上是一组散点图。我无法弄清如何将滑块分配给此变量 - 在ggvis中可以吗？

一个简化的数据集：

data <- data.frame(year=rep(2000:2002, each=23), 
                   x=rnorm(23*3,10), y=rnorm(23*3,10),
                   count=c(rnorm(23,2), rnorm(23,4), rnorm(23,6)))

我尝试过的方法：

### This is what is looks like in ggplot2, I'm aiming to be able to toggle 
### between these panels
ggplot(data, aes(x, y, size=count)) + geom_point() + facet_grid(~year)

### Here is where I'm at with ggvis
data %>% 
   ggvis(~x, ~y, size=~count) %>% 
   layer_points() 
# I'm not sure how to assign a variable (year) to a slider, I've been trying 
# within the layer_points() function

### I also tried using the props() function, but I don't fully understand 
### how to use it.
data %>% 
    ggvis(~x, ~y, size=~count) %>% 
    layer_points() %>% 
    props(prop("fill", input_slider(min(data$year), max(data$year)))) #error message

任何帮助都会受到赞赏！
你可以简化样本数据集的创建：df = data.frame(year=rep(2000:2002, each=23), x=rnorm(23*3,10), y=rnorm(23*3,10), count=c(rnorm(23,2),rnorm(23,4),rnorm(23,6))) - eipi10
2个回答
6

我不确定您是否希望使用滑块来筛选数据点（即仅显示从滑块选择的年份开始的数据点），还是根据滑块的值以不同颜色显示年份。

情况1（仅显示特定年份的数据点）

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity=input_slider(min(data$year), max(data$year), step=1, 
                                 map=function(x) ifelse(data$year == x, 1, 0)))

案例2（突出显示所选年份）

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(fill=input_slider(min(data$year), max(data$year), step=1, 
                                 map=function(x) factor(x == data$year)))

编辑2：如何简单包装left_right()函数。

在第一次编辑中，我提供了一个解决方案，它不能被正确地认为是“包装”。 我想创建一个反应性对象的包装器，避免完全修改create_keyboard_event。

在更全面地阅读了ggvis的源代码和更多关于R中S4对象的内容之后， 我意识到，是的，您可以简单地包装一个反应性对象，只要适当地保留broker类及其broker属性。

这使我们能够编写更优雅的代码，例如：

year_lr <- left_right(1997, 2002, value=2000, step=1)
year_wrapper <- reactive({
  as.numeric(year_lr() == data$year) 
})

class(year_wrapper) <- c("broker", class(year_wrapper))
attr(year_wrapper, "broker") <- attr(year_lr, "broker")

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity:=year_wrapper)

编辑：如何创建自己的（修改后的）left_right()函数

用户3389288问了我一个好问题，就是既然您的left_right()函数没有map参数，那么如何绑定键盘事件以生成自定义参数呢？例如，在这个问题的上下文中，我们如何将left_right()调整为年份过滤器？

如果您深入研究ggvis的源代码，您会发现left_right()只是一个简单的包装函数，调用了create_keyboard_event。

因此，我们可以创建自己版本的left_right()，甚至是h_j_k_l()，比如说如果您是Vi的狂热者。但是，有一个大的限制，如果您深入一层来查看create_keyboard_event的实现，您会发现它并不完全适合我们的任务。

这是因为为了显示部分点，同时隐藏其他点，我们必须让left_right()返回一个vector（等于data行数）。然而，left_right()和create_keyboard_event()都假设返回值（也是通过左/右键按下修改的value的当前状态）是一个标量。

为了将返回值（向量）与缓存的当前状态（标量，即年份）分开，我们必须创建一个稍微修改过的版本的left_right()和create_keyboard_event()。

下面是可行的源代码。

data <- data.frame(year=rep(1997:2002, each=12), 
                   x=rnorm(24*3,10), y=rnorm(24*3,10),
                   count=c(rnorm(24,2), rnorm(24,4), rnorm(24,6)))

create_keyboard_event2 <- function(map, default.x = NULL, default.res = NULL) {
  # A different version of ggvis::create_keyboard_event function:
  # the major different is that the map function returns a list,
  # list$x is the current value and list$res the result (returned to a ggvis prop).

  # this seperation allows us to return a vector of different
  # values instead of a single scalar variable.

  if (!is.function(map)) stop("map must be a function")

  vals <- shiny::reactiveValues()
  vals$x <- default.x
  vals$res <- default.res

  # A reactive to wrap the reactive value
  res <- reactive({
    vals$res
  })

  # This function is run at render time.
  connect <- function(session, plot_id) {
    key_press_id  <- paste0(plot_id, "_key_press")

    shiny::observe({
      key_press <- session$input[[key_press_id]]

      if (!is.null(key_press)) {
        # Get the current value of the reactive, without taking a dependency
        current_value <- shiny::isolate(vals$x)

        updated <- map(key_press, current_value)

        vals$x <- updated$x
        vals$res <- updated$res
      }

    })
  }
  ggvis:::connector_label(connect) <- "key_press"

  spec <- list(type = "keyboard")
  ggvis:::create_broker(res, connect = connect, spec = spec)
}

# a modified version of left_right. this closure encapsulates the
# data "year", allowing us to perform comparison of the current state of
# left_right (numeric year number) to the year vector.

left_right_year <- function(min, max, value = (min + max) / 2,
                       step = (max - min) / 40, year) {

  # Given the key_press object and current value, return the next value
  map <- function(key_press, current_value) {
    key <- key_press$value

    print(current_value)

    if (key == "left") {
      new_value <- pmax(min, current_value - step)

    } else if (key == "right") {
      new_value <- pmin(max, current_value + step)

    } else {
      new_value = current_value
    }

    list(x=new_value, res=as.numeric(year == new_value))

  }

  create_keyboard_event2(map, value, as.numeric(value==year))
}

# now with an additional argument, the data$year
alpha_by_year <- left_right_year(1997, 2002, value=2000, step=1, data$year)

data %>% 
  ggvis(~x, ~y, size=~count) %>% 
  layer_points(opacity:=alpha_by_year) # if you let left_right_year return
  # a factor vector, you can use fill:=... as well

您可以将left_right_year和create_keyboard_event2与它们的原始版本进行比较。

例如，原始的create_keyboard_event是：

create_keyboard_event <- function(map, default = NULL) {
  if (!is.function(map)) stop("map must be a function")

  vals <- shiny::reactiveValues()
  vals$x <- default

  # A reactive to wrap the reactive value
  res <- reactive({
    vals$x
  })

  # This function is run at render time.
  connect <- function(session, plot_id) {
    key_press_id  <- paste0(plot_id, "_key_press")

    shiny::observe({
      key_press <- session$input[[key_press_id]]

      if (!is.null(key_press)) {
        # Get the current value of the reactive, without taking a dependency
        current_value <- shiny::isolate(vals$x)

        vals$x <- map(key_press, current_value)
      }

    })
  }
  connector_label(connect) <- "key_press"

  spec <- list(type = "keyboard")
  create_broker(res, connect = connect, spec = spec)
}

您可以看到，我们修改后的版本不仅缓存了当前状态的vals$x，还缓存了返回向量vals$res。

vals是一种反应式值。这个概念来源于Shiny。您可以查看这篇文档，了解有关反应式值和整体反应性的高级概述。

有待回答的问题

由于vals$x本身是一个反应式值。直观地说，如果

x <- left_right(1, 100, value=20, step=10)

那么

y <- reactive(x() * 2)

应该让我们能够实现快速的map函数。

然而它并没有像预期的那样工作。我还没有弄清楚为什么。如果您知道答案，请友情提供！

更新：请参见EDIT2。

抱歉我没有看到你的 ggplot2 代码。如果你想让结果看起来更像 facet_wrap，也许你会喜欢第一个解决方案。你还可以通过将 map 函数中的 == 改为 > 来查看点的累计情况。 - Xin Yin
非常好，谢谢！由于left_right()函数没有地图参数，您知道是否仍然可以使用该函数而不是滑块吗？只是好奇！ - user3389288
答案是可以的，但不幸的是这并不容易。我可以更新我的回答，给你更详细的解释。 - Xin Yin
这太棒了 - 感谢您提供深入的答案！！ - user3389288
嘿，user3389288，我在弄清楚如何编写left_right()的简单包装器后，又编辑了我的答案。你可能想使用这种新方法，因为它更容易，而且出错的可能性更小。 - Xin Yin
0

上面的回答非常棒，值得学习。这是我为原问题想到的快速解决方案。

Global.R:


    library(shiny)
    library(ggvis)

        data<-data.frame(year=rep(2000:2002, each=23), x=rnorm(23*3,10), y=rnorm(23*3,10),
                        count=c(rnorm(23,2),rnorm(23,4),rnorm(23,6)))

ui.R:


     shinyUI(bootstrapPage(
         h3("Ploting Diferent Years Using a Slider",align="center"),
         br(),
         fluidRow(column(4,ggvisOutput("yearPlot"),offset=3)),
         fluidRow(column(3,sliderInput("YearSelect", "Year:     ",min=2000,max=2002,step=1,value=2000),offset=5))
))

Server.R:



    shinyServer(function(input, output,session) {

    plotdata <- reactive({
        chosendat <- data[data$year==input$YearSelect, ]
        names(chosendat) <- c("year","xvar","yvar","count")
        return(chosendat)
      })

    vis1% ggvis(~xvar, ~yvar, size=~count) %>% layer_points() 

    })

    vis1 %>% bind_shiny("yearPlot")

    })
使用Shiny绝对是另一个可行的选择。然而，我从来不喜欢Shiny和ggvis中的滑块。它不支持点击，只支持拖动。而且在拖动时没有去抖动：特别是如果您设置了非常精细的“步骤”参数，会向Shiny服务器发送大量的更改事件。 - Xin Yin
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接