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

任何帮助表示赞赏！

4

2 回答 2

6

我不确定您是否想将滑块用于filter数据点（即仅显示滑块上所选年份的那些点），或者根据滑块的值以不同颜色显示年份。

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

EDIT2：如何简单地包装一个left_right()函数。

在第一次编辑中，我提出了一个未被正确视为wrapping的解决方案。我有兴趣创建由返回的反应对象的包装器left_right()，避免create_keyboard_event一起修改。

在阅读了 R 中关于 S4 对象的更彻底和更多的源代码后ggvis，我意识到是的，你可以简单地包装一个反应性对象，只要你适当地保留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()函数

user3389288 问了我一个很好的问题，既然你没有函数的map参数left_right()，你怎么能真正绑定键盘事件来生成自定义参数。例如，在这个问题的背景下，我们如何定制left_right()为年份过滤器？

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

因此，我们可以创建我们自己的版本left_right()，甚至可以h_j_k_l()说如果您对 Vi 很狂热。但是，这里有个很大的问题，如果你再深入一层来看看 的实现create_keyboard_event，你会发现它不太适合我们的任务。

这是因为为了显示一些点，同时隐藏其他点，我们必须让left_rightreturn a vector（等于 中的行数data）。但是，两者left_right和create_keyboard_event都是在假设返回值（也是value左/右键修改的当前状态）是标量的情况下创建的。

为了将返回值（向量）与缓存的当前状态（标量，即年份）分开，我们必须创建一个稍加修改的left_right()and版本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功能。

但是它没有按预期工作。我还没有弄清楚为什么。如果你知道答案，请告诉我！

更新：cf EDIT2

于 2014-08-08T21:12:05.097 回答
0

上面的答案很棒。绝对值得研究。这是我为快速修复的原始问题提出的。

全球.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))
))

服务器.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")

    })
于 2014-08-09T12:31:48.923 回答