add scales and legends

DESCRIPTION

@@ -22,6 +22,7 @@ Imports:
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.0
 Collate: 
+    'draw_key_texture.R'
     'geom-textured-rect.R'
     'geom-textured-bar.R'
     'geom-isotype-bar.R'

NAMESPACE

@@ -6,11 +6,15 @@ export(GeomIsotypeCol)
 export(GeomTexturedBar)
 export(GeomTexturedCol)
 export(GeomTexturedRect)
+export(draw_key_texture)
 export(geom_isotype_bar)
 export(geom_isotype_col)
 export(geom_textured_bar)
 export(geom_textured_col)
 export(geom_textured_rect)
+export(scale_image_discrete)
+export(scale_image_identity)
+export(scale_image_manual)
 export(texture_grob)
 import(ggplot2)
 import(grid)

R/draw_key_texture.R

@@ -0,0 +1,25 @@
+#' Key drawing function for textured rectangles
+#'
+#' @inheritParams ggplot2::draw_key_polygon
+#' @export
+draw_key_texture <- function(data, params, size) {
+  lwd <- min(data$size, min(size) / 4)
+
+  texture_grob(
+    get_raster_image(data$image),
+    x = unit(0.5, "npc"), y = unit(0.5, "npc"),
+    width = unit(1, "npc") - unit(lwd, "mm"),
+    height = unit(1, "npc") - unit(lwd, "mm"),
+    img_width = unit(1, "null"),
+    img_height = NULL,
+    nrow = 1,
+    ncol = 1,
+    hjust = data$hjust,
+    vjust = data$vjust,
+    just = c(0.5, 0.5),
+    color = data$colour,
+    fill = scales::alpha(data$fill, data$alpha),
+    lwd = lwd * .pt,
+    lty = data$linetype
+  )
+}

R/geom-isotype-bar.R

@@ -20,14 +20,15 @@
 #' @examples
 #' library(ggplot2)
 #' library(tibble)
+#' library(magick)
 #'
 #' data <- tibble(
 #'   count = c(5, 3, 6),
 #'   animal = c("giraffe", "elephant", "horse"),
 #'   image = list(
-#'     "http://steveharoz.com/research/isotype/icons/giraffe.svg",
-#'     "http://steveharoz.com/research/isotype/icons/elephant.svg",
-#'     "http://steveharoz.com/research/isotype/icons/horse.svg"
+#'     image_read_svg("http://steveharoz.com/research/isotype/icons/giraffe.svg"),
+#'     image_read_svg("http://steveharoz.com/research/isotype/icons/elephant.svg"),
+#'     image_read_svg("http://steveharoz.com/research/isotype/icons/horse.svg")
 #'   )
 #' )
 #'
@@ -38,7 +39,7 @@
 #' ggplot(data, aes(animal, count, image = image)) +
 #'   geom_isotype_col(
 #'     img_width = grid::unit(1, "native"), img_height = NULL,
-#'     ncol = NA, nrow = 1, hjust = 0, vjust = 0.5
+#'     ncol = NA, nrow = 1, hjust = 0, vjust = 0.5, fill = "#80808040"
 #'   ) +
 #'   coord_flip() +
 #'   theme_minimal()

R/geom-textured-bar.R

@@ -12,16 +12,18 @@
 #' df <- tibble(
 #'   trt = c("a", "b", "c"),
 #'   outcome = c(2.3, 1.9, 3.2),
-#'   image = list("http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
-#'                "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
-#'                "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg")
+#'   image = c(
+#'     "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
+#'     "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
+#'     "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg"
 #'   )
+#' )
 #'
 #' ggplot(df, aes(trt, outcome, image = image)) +
 #'   geom_textured_col()
 #'
 #' # textured bars
-#' image = list(
+#' images = c(
 #'   compact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
 #'   midsize = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
 #'   suv = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg",
@@ -31,11 +33,13 @@
 #'   subcompact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/concrete1-256.jpg"
 #' )
 #'
-#' mpg$image <- image[mpg$class]
-#'
-#' ggplot(mpg, aes(class, image = image)) + geom_textured_bar()
+#' ggplot(mpg, aes(class, image = class)) +
+#'   geom_textured_bar() +
+#'   scale_image_manual(values = images)
 #'
-#' ggplot(mpg, aes(factor(trans), group = class, image = image)) + geom_textured_bar()
+#' ggplot(mpg, aes(factor(trans), image = class)) +
+#'   geom_textured_bar() +
+#'   scale_image_manual(values = images)
 #' @export
 geom_textured_bar <- function(mapping = NULL, data = NULL,
                               stat = "count", position = "stack",

R/geom-textured-rect.R

@@ -7,11 +7,14 @@
 #' @examples
 #' library(ggplot2)
 #' library(tibble)
+#' library(magick)
 #'
 #' data <- tibble(
 #'   xmin = c(1, 2.5), ymin = c(1, 1), xmax = c(2, 4), ymax = c(4, 3),
-#'   image = list("https://jeroen.github.io/images/Rlogo.png",
-#'                "https://jeroen.github.io/images/tiger.svg")
+#'   image = list(
+#'     "https://jeroen.github.io/images/Rlogo.png",
+#'     image_read_svg("https://jeroen.github.io/images/tiger.svg")
+#'    )
 #' )
 #'
 #' ggplot(data, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, image = image)) +
@@ -114,7 +117,7 @@ GeomTexturedRect <- ggproto("GeomTexturedRect",
     }
   },
 
-  draw_key = draw_key_polygon
+  draw_key = draw_key_texture
 )
 
 get_raster_image <- function(img) {

R/scale-image.R

@@ -1 +1,19 @@
-#
+#' Image scales
+#'
+#' @inheritParams ggplot2::scale_discrete_identity
+#' @inheritParams ggplot2::scale_discrete_manual
+#' @export
+scale_image_identity <- function(..., guide = "none", aesthetics = "image")
+  scale_discrete_identity(aesthetics, ..., guide = guide)
+
+
+#' @rdname scale_image_identity
+#' @format NULL
+#' @usage NULL
+#' @export
+scale_image_discrete <- scale_image_identity
+
+#' @rdname scale_image_identity
+#' @export
+scale_image_manual <- function(..., values, aesthetics = "image")
+  scale_discrete_manual(aesthetics, ..., values = values)

README.Rmd

@@ -33,8 +33,9 @@ Basic example of a textured rectangle drawn with grid:
 ```{r texture-grob}
 library(ggtextures)
 library(grid)
+library(magick)
 
-img <- magick::image_read("https://jeroen.github.io/images/Rlogo.png")
+img <- image_read("https://jeroen.github.io/images/Rlogo.png")
 
 grid.newpage()
 tg1 <- texture_grob(
@@ -54,39 +55,41 @@ grid.draw(tg1)
 grid.draw(tg2)
 ```
 
-Basic example of textured rectangles in ggplot2:
+This is a basic example of textured rectangles in ggplot2:
 ```{r geom-textured-rect}
 library(ggplot2)
 library(tibble)
 
 data <- tibble(
   xmin = c(1, 2.5), ymin = c(1, 1), xmax = c(2, 4), ymax = c(4, 3),
-  image = list("https://jeroen.github.io/images/Rlogo.png",
-               "https://jeroen.github.io/images/tiger.svg")
+  image = list(
+    "https://jeroen.github.io/images/Rlogo.png",
+    image_read_svg("https://jeroen.github.io/images/tiger.svg")
+  )
 )
 
 ggplot(data, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, image = image)) +
-  geom_textured_rect()
+  geom_textured_rect(img_width = unit(1, "in"))
 ```
+Note that we are reading in the svg file explicitly, using the function `image_read_svg()` from the magick package. This is needed for proper handling of transparencies in svg files.
 
-Textured equivalent to `geom_col()`:
+
+We can also make a textured equivalent to `geom_col()` or `geom_bar()`:
 ```{r geom-textured-col}
 df <- tibble(
   trt = c("a", "b", "c"),
   outcome = c(2.3, 1.9, 3.2),
-  image = list("http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
-               "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
-               "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg")
+  image = c(
+    "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
+    "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
+    "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg"
   )
+)
 
 ggplot(df, aes(trt, outcome, image = image)) +
-  geom_textured_col()
-```
-
+  geom_textured_col(img_width = unit(0.5, "null"))
 
-Textured equivalent to `geom_bar()`:
-```{r geom-textured-bar}
-image = list(
+images = c(
   compact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
   midsize = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
   suv = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg",
@@ -96,11 +99,13 @@ image = list(
   subcompact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/concrete1-256.jpg"
 )
 
-mpg$image <- image[mpg$class]
-
-ggplot(mpg, aes(class, image = image)) + geom_textured_bar()
+ggplot(mpg, aes(class, image = class)) +
+  geom_textured_bar() +
+  scale_image_manual(values = images)
 
-ggplot(mpg, aes(factor(trans), group = class, image = image)) + geom_textured_bar()
+ggplot(mpg, aes(factor(trans), image = class)) +
+  geom_textured_bar() +
+  scale_image_manual(values = images)
 ```
 
 Isotype bars can be drawn with `geom_isotype_bar()` and `geom_isotype_col()`. The units of the images are set as grid native units. Default is that the image height corresponds to one data unit.
@@ -109,9 +114,9 @@ data <- tibble(
   count = c(5, 3, 6),
   animal = c("giraffe", "elephant", "horse"),
   image = list(
-    "http://steveharoz.com/research/isotype/icons/giraffe.svg",
-    "http://steveharoz.com/research/isotype/icons/elephant.svg",
-    "http://steveharoz.com/research/isotype/icons/horse.svg"
+    image_read_svg("http://steveharoz.com/research/isotype/icons/giraffe.svg"),
+    image_read_svg("http://steveharoz.com/research/isotype/icons/elephant.svg"),
+    image_read_svg("http://steveharoz.com/research/isotype/icons/horse.svg")
   )
 )
 
@@ -122,7 +127,7 @@ ggplot(data, aes(animal, count, image = image)) +
 ggplot(data, aes(animal, count, image = image)) +
   geom_isotype_col(
     img_width = grid::unit(1, "native"), img_height = NULL,
-    ncol = NA, nrow = 1, hjust = 0, vjust = 0.5
+    ncol = NA, nrow = 1, hjust = 0, vjust = 0.5, fill = "#80808040"
   ) +
   coord_flip() +
   theme_minimal()