Shapes provided via strings instead of integers

NEWS.md

@@ -166,6 +166,9 @@ up correct aspect ratio, and draws a graticule.
 * `guide_train()`, `guide_merge()`, `guide_geom()`, and `guide_gengrob()`
   are now exported as they are needed if you want to design your own guide.
   They are not currently documented; use at your own risk (#2528).
+
+* Shapes can now be provided using strings instead of integers (i.e.
+  `geom_point(shape = "diamond")`) (@daniel-barnett, #2075). 
 
 ## Breaking changes
 
@@ -177,6 +180,7 @@ up correct aspect ratio, and draws a graticule.
   use matrix-columns. These are rarely used but are produced by `scale()`;
   to continue use `scale()` you'll need to wrap it with `as.numeric()`, 
   e.g. `as.numeric(scale(x))`.
+>>>>>>> upstream/master
 
 ## Minor bug fixes and improvements
 

R/geom-point.r

@@ -126,6 +126,10 @@ GeomPoint <- ggproto("GeomPoint", Geom,
   ),
 
   draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
+    if (is.character(data$shape)) {
+      data$shape <- translate_shape_string(data$shape)
+    }
+
     coords <- coord$transform(data, panel_params)
     ggname("geom_point",
       pointsGrob(
@@ -144,3 +148,90 @@ GeomPoint <- ggproto("GeomPoint", Geom,
 
   draw_key = draw_key_point
 )
+
+translate_shape_string <- function(shape_string) {
+  if (nchar(shape_string[1]) == 1) {
+    return(shape_string)
+  }
+
+  pch_table <- c(
+    "square open"           = 0,
+    "circle open"           = 1,
+    "triangle open"         = 2,
+    "plus"                  = 3,
+    "cross"                 = 4,
+    "diamond open"          = 5,
+    "triangle down open"    = 6,
+    "square cross"          = 7,
+    "asterisk"              = 8,
+    "diamond plus"          = 9,
+    "circle plus"           = 10,
+    "star"                  = 11,
+    "square plus"           = 12,
+    "circle cross"          = 13,
+    "square triangle"       = 14,
+    "square"                = 15,
+    "circle small"          = 16,
+    "triangle"              = 17,
+    "diamond"               = 18,
+    "circle"                = 19,
+    "bullet"                = 20,
+    "circle filled"         = 21,
+    "square filled"         = 22,
+    "diamond filled"        = 23,
+    "triangle filled"       = 24,
+    "triangle down filled"  = 25
+  )
+
+  shape_match <- charmatch(shape_string, names(pch_table))
+
+  invalid_strings <- is.na(shape_match)
+  nonunique_strings <- shape_match == 0
+
+  if (any(invalid_strings)) {
+    bad_string <- unique(shape_string[invalid_strings])
+    n_bad <- length(bad_string)
+
+    collapsed_names <- sprintf("\n* '%s'", bad_string[1:min(5, n_bad)])
+
+    more_problems <- if (n_bad > 5) {
+      sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", ""))
+    }
+
+    stop(
+      "Can't find shape name:",
+      collapsed_names,
+      more_problems,
+      call. = FALSE
+    )
+  }
+
+  if (any(nonunique_strings)) {
+    bad_string <- unique(shape_string[nonunique_strings])
+    n_bad <- length(bad_string)
+
+    n_matches <- vapply(
+      bad_string[1:min(5, n_bad)],
+      function(shape_string) sum(startsWith(names(pch_table), shape_string)),
+      integer(1)
+    )
+
+    collapsed_names <- sprintf(
+      "\n* '%s' partially matches %d shape names",
+      bad_string[1:min(5, n_bad)], n_matches
+    )
+
+    more_problems <- if (n_bad > 5) {
+      sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", ""))
+    }
+
+    stop(
+      "Shape names must be unambiguous:",
+      collapsed_names,
+      more_problems,
+      call. = FALSE
+    )
+  }
+
+  unname(pch_table[shape_match])
+}

R/legend-draw.r

@@ -15,6 +15,10 @@ NULL
 #' @export
 #' @rdname draw_key
 draw_key_point <- function(data, params, size) {
+  if (is.character(data$shape)) {
+    data$shape <- translate_shape_string(data$shape)
+  }
+
   pointsGrob(0.5, 0.5,
     pch = data$shape,
     gp = gpar(

tests/testthat/test-geom-point.R

@@ -0,0 +1,32 @@
+context("translate_shape_string")
+
+test_that("strings translate to their corresponding integers", {
+  shape_strings <- c(
+    "square open",
+    "circle open",
+    "triangle open"
+  )
+
+  expect_equal(translate_shape_string(shape_strings[1]), 0)
+  expect_equal(translate_shape_string(shape_strings), 0:2)
+
+  expect_equal(
+    translate_shape_string(rep.int(shape_strings[1], 10)),
+    rep.int(0, 10)
+  )
+
+  expect_equal(
+    translate_shape_string(rep(shape_strings, each = 4)),
+    rep(0:2, each = 4)
+  )
+})
+
+test_that("single characters are not translated to integers", {
+  expect_equal(translate_shape_string(letters), letters)
+  expect_equal(translate_shape_string(as.character(0:9)), as.character(0:9))
+})
+
+test_that("invalid shape names raise an error", {
+  expect_error(translate_shape_string("void"), "Can't find shape name")
+  expect_error(translate_shape_string("tri"), "Shape names must be unambiguous")
+})