Implement groupwise() and layer_axial_lines()

NAMESPACE

@@ -10,6 +10,7 @@ S3method(apply_scale_defaults,scale_numeric)
 S3method(apply_scale_defaults,scale_ordinal)
 S3method(as.character,prop_band)
 S3method(as.character,prop_constant)
+S3method(as.character,prop_group)
 S3method(as.character,prop_reactive)
 S3method(as.character,prop_variable)
 S3method(as.data.frame,singular)
@@ -94,6 +95,7 @@ S3method(new_prop,band)
 S3method(new_prop,call)
 S3method(new_prop,default)
 S3method(new_prop,formula)
+S3method(new_prop,groupwise)
 S3method(new_prop,name)
 S3method(new_prop,prop)
 S3method(new_prop,reactive)
@@ -112,19 +114,23 @@ S3method(print,singular)
 S3method(print,template)
 S3method(prop_domain,prop_band)
 S3method(prop_domain,prop_constant)
+S3method(prop_domain,prop_group)
 S3method(prop_domain,prop_reactive)
 S3method(prop_domain,prop_variable)
 S3method(prop_label,prop_band)
 S3method(prop_label,prop_constant)
+S3method(prop_label,prop_group)
 S3method(prop_label,prop_reactive)
 S3method(prop_label,prop_variable)
 S3method(prop_type,data.frame)
 S3method(prop_value,prop_band)
 S3method(prop_value,prop_constant)
+S3method(prop_value,prop_group)
 S3method(prop_value,prop_reactive)
 S3method(prop_value,prop_variable)
 S3method(prop_vega,prop_band)
 S3method(prop_vega,prop_constant)
+S3method(prop_vega,prop_group)
 S3method(prop_vega,prop_reactive)
 S3method(prop_vega,prop_variable)
 S3method(remove_missing,data.frame)
@@ -216,6 +222,7 @@ export(group_by_.ggvis)
 export(group_by_.reactive)
 export(groups.ggvis)
 export(groups.reactive)
+export(groupwise)
 export(handle_brush)
 export(handle_click)
 export(handle_hover)
@@ -245,6 +252,7 @@ export(is.prop_variable)
 export(is.scaled_value)
 export(knit_print.ggvis)
 export(layer_arcs)
+export(layer_axial_lines)
 export(layer_bars)
 export(layer_boxplots)
 export(layer_densities)

R/ggvis.R

@@ -290,6 +290,14 @@ register_scales_from_props <- function(vis, props) {
       label <- NULL
     }
 
+    if (is.prop_group(prop) && prop_is_scaled(prop)) {
+      vis <- add_scale(
+        vis,
+        ggvis_scale(property = propname_to_scale(prop$property),
+          name = prop$scale, label = label)
+      )
+      return(vis)
+    }
     if (is.prop_band(prop)) {
       # band() requires points = FALSE
       vis <- add_scale(

R/layer_axial.R

@@ -0,0 +1,63 @@
+#' Draw vertical or horizontal lines
+#'
+#' This adds axial lines to the plot, that is, lines that are parallel
+#' to the axes. For each \code{x}, a vertical line spanning the
+#' plot is created. Each \code{y} will result in a vertical line.
+#' @inheritParams marks
+#' @export
+#' @examples
+#' # In this example we will represent graphically the means of the
+#' # mixture components of the faithful dataset.
+#' # First we compute the means of each component:
+#' library("dplyr")
+#' means <- faithful %>%
+#'   mutate(left = eruptions < 3) %>%
+#'   group_by(left) %>%
+#'   summarise(values = mean(eruptions))
+#'
+#' # Now we draw vertical lines corresponding to those means, plus an
+#' # horizontal line 100 pixel from the top of the plot
+#' ggvis(faithful) %>%
+#'   layer_histograms(~eruptions) %>%
+#'   layer_axial_lines(data = means,
+#'     x = ~values, y := 100,
+#'     stroke := "red", strokeWidth := 4
+#'   )
+layer_axial_lines <- function(vis, ..., data = NULL) {
+  props <- props(..., env = parent.frame())
+  props_names <- trim_prop_event(names(props))
+
+  is_x <- "x" == props_names
+  is_y <- "y" == props_names
+
+  if ("x2" %in% props_names || "y2" %in% props_names) {
+    stop("Cannot have x2 or y2 property", call. = FALSE)
+  }
+  if (sum(is_x) > 1 || sum(is_y) > 1) {
+    stop("Cannot have more than one event for x and y", call. = FALSE)
+  }
+
+  if (any(is_x)) {
+    x2_prop <- props[[which(is_x)]]
+    x2_prop$property <- "x2"
+    x2_prop_name <- paste0("x2.", x2_prop$event)
+    v_props <- props[!is_y]
+    v_props[[x2_prop_name]] <- x2_prop
+    v_props$y <- prop("y", 0)
+    v_props$y2 <- prop("y2", groupwise("height"))
+    vis <- add_mark(vis, "rule", v_props, data, deparse2(substitute(data)))
+  }
+
+  if (any(is_y)) {
+    y2_prop <- props[[which(is_y)]]
+    y2_prop$property <- "y2"
+    y2_prop_name <- paste0("y2.", y2_prop$event)
+    h_props <- props[!is_x]
+    h_props[[y2_prop_name]] <- y2_prop
+    h_props$x <- prop("x", 0)
+    h_props$x2 <- prop("x2", groupwise("width"))
+    vis <- add_mark(vis, "rule", h_props, data, deparse2(substitute(data)))
+  }
+
+  vis
+}

R/marks.R

@@ -113,6 +113,7 @@ valid_props <- list(
   image = c(common_valid_props, "x2", "y2", "width", "height", "url", "align",
     "baseline"),
   line = c(common_valid_props, "interpolate", "tension"),
+  rule = c(common_valid_props, "x2", "y2", "width", "height"),
   rect = c(common_valid_props, "x2", "y2", "width", "height"),
   symbol = c(common_valid_props, "size", "shape"),
   text = c(common_valid_props, "text", "align", "baseline", "dx", "dy", "angle",
@@ -144,6 +145,7 @@ default_props <- function(type) {
     arc = props(fill := "#333333"),
     area = props(fill := "#333333"),
     line = props(stroke := "#000000"),
+    rule = props(stroke := "#000000"),
     image = props(fill := "#000000"),
     rect = props(stroke := "#000000", fill := "#333333"),
     symbol = props(fill := "#000000", size := 50),

R/prop_group.R

@@ -0,0 +1,94 @@
+#' Groupwise property
+#'
+#' \code{groupwise()} is used to refer to properties of the plot or
+#' subvisualisation, typically the height or the width.
+#' @param prop Name of the group property. Typically "height" or "width".
+#' @param offset,mult Additive and multiplicate offsets.
+#' @export
+#' @examples
+#' # In the following example, we draw a rectangle running vertically
+#' # across the plot by referring to its total height
+#' ggvis(faithful) %>%
+#'   layer_histograms(~eruptions) %>%
+#'   emit_rects(props(
+#'     x = ~mean(eruptions), width := 40,
+#'     y := 0, y2 := groupwise("height"),
+#'     fill := "red"
+#'   ))
+#'
+#' # The mult factor is useful to draw elements at fixed fractions
+#' # of the plot:
+#' ggvis(mtcars, ~mpg) %>%
+#'   layer_histograms() %>%
+#'   layer_axial_lines(y := groupwise("height", mult = 0.5),
+#'     stroke := "red", strokeWidth := 4)
+#'
+#' # Combining mult and offset makes it is easy to place elements where
+#' # you want them
+#' ggvis(faithful) %>%
+#'   layer_histograms(~eruptions) %>%
+#'   emit_rects(props(
+#'     x := 30, x2 := groupwise("width", -15, 0.5),
+#'     y := 30, y2 := groupwise("height", -30),
+#'     fill := "red"
+#'   )) %>%
+#'   emit_rects(props(
+#'     x := groupwise("width", 15, 0.5), x2 := groupwise("width", -30),
+#'     y := groupwise("height", -30), y2 := 30,
+#'     fill := "blue"
+#'   ))
+groupwise <- function(prop, offset = NULL, mult = NULL) {
+  structure(
+    list(group_prop = prop, offset = offset, mult = mult),
+    class = c("groupwise")
+  )
+}
+
+#' @export
+new_prop.groupwise <- function(x, property, scale, offset, mult, env, event,
+                               label) {
+  structure(
+    list(
+      property = property,
+      scale = decide_scale(scale %||% FALSE, property),
+      offset = x$offset,
+      mult = x$mult,
+      event = event,
+      env = NULL,
+      group_prop = x$group_prop
+    ),
+    class = c("prop_group", "prop")
+  )
+}
+
+#' @export
+as.character.prop_group <- function(x, ...) ""
+
+#' @rdname groupwise
+#' @param x object to test for group-ness
+is.prop_group <- function(x) inherits(x, "prop_group")
+
+#' @export
+prop_value.prop_group <- function(x, data) {
+  NULL
+}
+
+#' @export
+prop_label.prop_group <- function(x) {
+  ""
+}
+
+#' @export
+prop_domain.prop_group <- function(x, data) {
+  NULL
+}
+
+#' @export
+prop_vega.prop_group <- function(x, default_scale) {
+  compact(list(
+    scale = x$scale,
+    mult = x$mult,
+    offset = x$offset,
+    group = x$group_prop
+  ))
+}

R/vega.R

@@ -145,6 +145,12 @@ as.vega.mark <- function(mark, in_group = FALSE) {
     }
   }
 
+  # Don't include reference to data when no prop needs it
+  is_variable <- vapply(mark$props, is.prop_variable, logical(1))
+  if (!any(is_variable)) {
+    m$from <- NULL
+  }
+
   if (!is.null(key)) {
     m$key <- paste0("data.", safe_vega_var(prop_label(key)))
   }

man/groupwise.Rd

@@ -0,0 +1,56 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/prop_group.R
+\name{groupwise}
+\alias{groupwise}
+\alias{is.prop_group}
+\title{Groupwise property}
+\usage{
+groupwise(prop, offset = NULL, mult = NULL)
+
+is.prop_group(x)
+}
+\arguments{
+\item{prop}{Name of the group property. Typically "height" or "width".}
+
+\item{offset,mult}{Additive and multiplicate offsets.}
+
+\item{x}{object to test for group-ness}
+}
+\description{
+\code{groupwise()} is used to refer to properties of the plot or
+subvisualisation, typically the height or the width.
+}
+\examples{
+# In the following example, we draw a rectangle running vertically
+# across the plot by referring to its total height
+ggvis(faithful) \%>\%
+  layer_histograms(~eruptions) \%>\%
+  emit_rects(props(
+    x = ~mean(eruptions), width := 40,
+    y := 0, y2 := groupwise("height"),
+    fill := "red"
+  ))
+
+# The mult factor is useful to draw elements at fixed fractions
+# of the plot:
+ggvis(mtcars, ~mpg) \%>\%
+  layer_histograms() \%>\%
+  layer_axial_lines(y := groupwise("height", mult = 0.5),
+    stroke := "red", strokeWidth := 4)
+
+# Combining mult and offset makes it is easy to place elements where
+# you want them
+ggvis(faithful) \%>\%
+  layer_histograms(~eruptions) \%>\%
+  emit_rects(props(
+    x := 30, x2 := groupwise("width", -15, 0.5),
+    y := 30, y2 := groupwise("height", -30),
+    fill := "red"
+  )) \%>\%
+  emit_rects(props(
+    x := groupwise("width", 15, 0.5), x2 := groupwise("width", -30),
+    y := groupwise("height", -30), y2 := 30,
+    fill := "blue"
+  ))
+}
+

man/layer_axial_lines.Rd

@@ -0,0 +1,42 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/layer_axial.R
+\name{layer_axial_lines}
+\alias{layer_axial_lines}
+\title{Draw vertical or horizontal lines}
+\usage{
+layer_axial_lines(vis, ..., data = NULL)
+}
+\arguments{
+\item{vis}{Visualisation to modify}
+
+\item{...}{A \code{\link{props}} object, named according to the
+properties listed below.}
+
+\item{data}{An optional dataset, if you want to override the usual data
+inheritance for this mark.}
+}
+\description{
+This adds axial lines to the plot, that is, lines that are parallel
+to the axes. For each \code{x}, a vertical line spanning the
+plot is created. Each \code{y} will result in a vertical line.
+}
+\examples{
+# In this example we will represent graphically the means of the
+# mixture components of the faithful dataset.
+# First we compute the means of each component:
+library("dplyr")
+means <- faithful \%>\%
+  mutate(left = eruptions < 3) \%>\%
+  group_by(left) \%>\%
+  summarise(values = mean(eruptions))
+
+# Now we draw vertical lines corresponding to those means, plus an
+# horizontal line 100 pixel from the top of the plot
+ggvis(faithful) \%>\%
+  layer_histograms(~eruptions) \%>\%
+  layer_axial_lines(data = means,
+    x = ~values, y := 100,
+    stroke := "red", strokeWidth := 4
+  )
+}
+

tests/testthat/test-props.r

@@ -312,3 +312,20 @@ test_that("band() is created properly", {
   expect_error(prop("x", band()))
   expect_error(props(x = band()))
 })
+
+test_that("groupwise() is created properly", {
+  # Group property is correctly set
+  expect_identical(prop("y", groupwise("height"))$group_prop, "height")
+
+  # Automatic setting of scale, event
+  test_prop(prop("y", groupwise("height")), "y", NULL, NULL, "update")
+
+  # Explicit settings of scale, event
+  test_prop(prop("x", groupwise("height"), scale = "x"), "x", NULL, "x")
+  test_prop(prop("x", groupwise("height"), event = "enter"), "x", NULL, NULL, "enter")
+  test_prop(prop("x", groupwise("height"), scale = "foo"), "x", NULL, "foo")
+
+  # Create with props()
+  test_prop(props("y" = groupwise("width"))$y.update, "y", NULL, "y", "update")
+  test_prop(props(y.enter = groupwise("width"))$y.enter, "y", NULL, "y", "enter")
+})