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()関数を単純にラップする方法。
最初の編集で、ラッピングとは適切に見なされない解決策を提示しました。によって返されるリアクティブ オブジェクトのラッパーを作成し、すべてを一緒にleft_right()変更することを避けることに興味がありました。create_keyboard_event
R の S4 オブジェクトのソース コードをより徹底的に読んだ後、クラスとその属性を適切ggvisに保持する限り、リアクティブ オブジェクトを単純にラップできることに気付きました。brokerbroker
これにより、次のようなより洗練されたコードを書くことができます。
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
したがって、独自のバージョンの を作成したり、Vi の熱狂的ファンであるとleft_right()さえ言えます。h_j_k_l()しかし、ここに大きな問題がありますが、さらに 1 つのレイヤーを掘り下げて の実装をcreate_keyboard_event調べると、このタスクにはあまり適していないことがわかります。
これは、一部のドットを表示し、他のドットを非表示にするには、 (の行数に等しい) をleft_right返さなければならないためです。ただし、とは両方とも、戻り値 (左/右キーの押下によって変更された の現在の状態でもあります) がスカラーであるという前提で作成されています。vectordataleft_rightcreate_keyboard_eventvalue
キャッシュされた現在の状態 (スカラー、つまりyear ) から戻り値 (ベクトル) を分離するために、わずかに変更されたバージョンの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はリアクティブ値です。コンセプトはシャイニーから借用。リアクティブ値とリアクティブ全般の概要については、このドキュメントをご覧ください。
まだ答えられていない質問
それvals$x自体がリアクティブな値であるためです。直感的に、
x <- left_right(1, 100, value=20, step=10)
それから
y <- reactive(x() * 2)
mapクイック関数を実装できるようにする必要があります。
ただし、期待どおりには機能しません。正確な理由はまだわかりません。答えが分かる方、よろしければ教えてください！
更新: EDIT2 を参照