Specifying colour in a geom_ using a character column

ggplot2

#1

I have made a new geom based on geom_point() and geom_jitter() to allow me to circle individual points based on a boolean column in my data. It is effectively drawing two sets of points but has the benefit of the points jitter in the same direction. However I seem to have lost the ability to specify the colour based on a character column.

With geom_point() and geom_jitter() you can set colour = to be a column of character strings and they are translated into different colours. In this situation I have had to split the colours aesthetic into two in order to control inner and outer points separately and in the process have lost the ability to specify colours with a character column.

Hopefully my reprex below illustrates this as I get the error:

Error in grDevices::col2rgb(colour, TRUE): invalid color name 'A'

Also if anyone can shed any light on why the legends disappeared it would be most appreciated.

library(tidyverse)

# New grob
GeomPointEn <- ggproto("GeomPoint", Geom,
                     required_aes = c("x", "y"),
                     non_missing_aes = c("size", "shape", "colour_inner", "colour_outer", "encirc"),
                     default_aes = aes(
                       shape = 19, colour_inner = "black", colour_outer = "red",
                       size = 1.5, fill = NA, alpha = NA, stroke = 0.5, encric = NA
                     ),
                     draw_key = draw_key_point,
                     
                     draw_panel = function(data, panel_params, coord, na.rm = FALSE) {

                       if(length(data$encirc) > 1){
                         checkmate::assert_logical(data$encirc, .var.name = "encirc")
                       }
                       
                       coords <- coord$transform(data, panel_params)
                       
                       inner_points <- ggplot2:::ggname("geom_point",
                              grid::pointsGrob(
                                coords$x, coords$y,
                                pch = coords$shape,
                                gp = grid::gpar(
                                  col = alpha(coords$colour_inner, coords$alpha),
                                  fill = alpha(coords$fill, coords$alpha),
                                  # Stroke is added around the outside of the point
                                  fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
                                  lwd = coords$stroke * .stroke / 2
                                )
                              )
                       )
                       
                       if(length(data$encirc) > 1){
                         coords_sub <- dplyr::filter(coords, encirc == T)
                         
                         outer_points <- ggplot2:::ggname("geom_point",
                                                grid::pointsGrob(
                                                  coords_sub$x, coords_sub$y,
                                                  pch = 21,
                                                  gp = grid::gpar(
                                                    col = alpha(coords_sub$colour_outer, coords_sub$alpha),
                                                    fill = alpha(coords_sub$fill, coords_sub$alpha),
                                                    # Stroke is added around the outside of the point
                                                    fontsize = 2.5 * coords_sub$size * .pt + coords_sub$stroke * .stroke / 2,
                                                    lwd = coords_sub$stroke * .stroke 
                                                  )
                                                )
                         )
                         
                         grid::gTree(children = grid::gList(inner_points, outer_points))
                       }
                       else{
                         return(inner_points)
                       }
                     }
                     
                     
)

# New geom
geom_point_en <- function(mapping = NULL, data = NULL,
                          stat = "identity", position = "identity",
                          ...,
                          na.rm = FALSE,
                          show.legend = NA,
                          inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomPointEn,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

# New geom
geom_jitter_en <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "jitter",
                        ...,
                        width = NULL,
                        height = NULL,
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
  if (!missing(width) || !missing(height)) {
    if (!missing(position)) {
      stop("Specify either `position` or `width`/`height`", call. = FALSE)
    }
    
    position <- position_jitter(width = width, height = height)
  }
  
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomPointEn,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

# Example of geom use
mtcars %>% 
  mutate(intrest = if_else(carb <= 2, T, F)) %>% 
  ggplot(aes(wt, mpg, encirc = intrest)) + 
  geom_jitter_en()


# works when colour column is numeric
ggplot(mtcars, aes(wt, mpg, colour_inner = carb)) + 
  geom_jitter_en()


# does not work when colour column is a character 
testcars <- dplyr::mutate(mtcars, a = c(LETTERS, LETTERS[1:6]))

ggplot(testcars, aes(wt, mpg, colour_inner = a)) + 
  geom_jitter_en()
#> Error in grDevices::col2rgb(colour, TRUE): invalid color name 'A'

# does work with geom_jitter()
ggplot(testcars, aes(wt, mpg, colour = a)) + 
  geom_jitter()

Created on 2018-04-01 by the reprex package (v0.2.0).


#2

I haven't worked through your code, but the colors in your working example,

# works when colour column is numeric
ggplot(mtcars, aes(wt, mpg, colour_inner = carb)) + 
  geom_jitter_en()

are the colors returned by default from the palette function at the numeric values of mtcars$carb:

palette()[sort(unique(mtcars$carb))]
## [1] "black"   "red"     "green3"  "blue"    "magenta" "gray"

ggplot(mtcars, aes(wt, mpg, colour = factor(carb))) + 
  geom_point() +
  scale_colour_manual(values=palette()[sort(unique(mtcars$carb))])   

Rplot114

So it looks like somehow your code may be trying to generate the colors from palette and failing when a column with character values that are not color names is used for colour_inner. For example:

palette(LETTERS[1:6])
## Error in palette(LETTERS[1:6]) : invalid color name 'A'

#3

I have made a bit of progress. Looking at the error:

Error in grDevices::col2rgb(colour, TRUE) : invalid color name 'A'

I looked at the traceback and found the line alpha(coords$colour_inner, coords$alpha) which I had altered in my code relative to geom_point(). Looking at the alpha() function it calls grDevices::col2rgb() so I think this accounts for the error.

I can reproduce the colours observed by @joels using alpha() and the observation that the colours are different to the ones ggplot2 uses by default was astute.

library(tidyverse)

alpha(sort(unique(mtcars$carb)), 1) ==  
  
palette()[sort(unique(mtcars$carb))] %>% # This just converts the strings to hex
  col2rgb() %>% 
  BBmisc::convertColsToList() %>% 
  map(~ rgb(.x[1], .x[2], .x[3], 255, maxColorValue=255)) %>% 
  unlist()
#> [1] TRUE TRUE TRUE TRUE TRUE TRUE

Created on 2018-04-02 by the reprex package (v0.2.0).

The problem therefore lies in what is being passed to alpha() which is coords. If I look inside coords I see it is a dataframe where the data is transformed by what I believe is the transform() function from base mediated by the panel_parems object. Significantly, aes values called "colour" get converted into hex values in geom_point() but not my "colour_inner" in geom_point_en(). Instead I get the aforementioned different set of colours from the `alpha()' call if the values are numeric and the error if they are not. This code demonstrates this:

library(ggplot2)

# Test geom_point
GeomPoint_test <- ggproto("GeomPoint_test", Geom,
                     required_aes = c("x", "y"),
                     non_missing_aes = c("size", "shape", "colour"),
                     default_aes = aes(
                       shape = 19, colour = "black", size = 1.5, fill = NA,
                       alpha = NA, stroke = 0.5
                     ),
                     
                     draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
                       coords <- coord$transform(data, panel_params)
                       print(head(coords))
                     },
                     
                     draw_key = draw_key_point
)

geom_point_test <- function(mapping = NULL, data = NULL,
                       stat = "identity", position = "identity",
                       ...,
                       na.rm = FALSE,
                       show.legend = NA,
                       inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomPoint_test,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

# Test geom_point_en
GeomPointEn_test <- ggproto("GeomPointEn_test", Geom,
                       required_aes = c("x", "y"),
                       non_missing_aes = c("size", "shape", "colour_inner", "colour_outer", "encirc"),
                       default_aes = aes(
                         shape = 19, colour_inner = "black", colour_outer = "red",
                         size = 1.5, fill = NA, alpha = NA, stroke = 0.5, encric = NA
                       ),
                       draw_key = draw_key_point,
                       
                       draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
                         
                         coords <- coord$transform(data, panel_params)
                         print(head(coords))
                       }
                       
                       
)

geom_point_en_test <- function(mapping = NULL, data = NULL,
                          stat = "identity", position = "identity",
                          ...,
                          na.rm = FALSE,
                          show.legend = NA,
                          inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomPointEn_test,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

# Coords output for geom_point() with numeric column
ggplot(mtcars, aes(wt, mpg, colour = carb)) +
  geom_point_test() 
#>    colour         x         y PANEL group shape size fill alpha stroke
#> 1 #2E618B 0.3027707 0.4555126     1    -1    19  1.5   NA    NA    0.5
#> 2 #2E618B 0.3620441 0.4555126     1    -1    19  1.5   NA    NA    0.5
#> 3 #132B43 0.2330374 0.5251451     1    -1    19  1.5   NA    NA    0.5
#> 4 #132B43 0.4410753 0.4709865     1    -1    19  1.5   NA    NA    0.5
#> 5 #1C3C5A 0.4933753 0.3665377     1    -1    19  1.5   NA    NA    0.5
#> 6 #132B43 0.4980242 0.3433269     1    -1    19  1.5   NA    NA    0.5
#> Error in gList(structure(list(name = "grill.gTree.13", gp = NULL, vp = NULL, : only 'grobs' allowed in "gList"

# Coords output for geom_point() with non-numeric column
ggplot(mtcars, aes(wt, mpg, colour = factor(carb))) +
  geom_point_test() 
#>    colour         x         y PANEL group shape size fill alpha stroke
#> 1 #00BFC4 0.3027707 0.4555126     1     4    19  1.5   NA    NA    0.5
#> 2 #00BFC4 0.3620441 0.4555126     1     4    19  1.5   NA    NA    0.5
#> 3 #F8766D 0.2330374 0.5251451     1     1    19  1.5   NA    NA    0.5
#> 4 #F8766D 0.4410753 0.4709865     1     1    19  1.5   NA    NA    0.5
#> 5 #B79F00 0.4933753 0.3665377     1     2    19  1.5   NA    NA    0.5
#> 6 #F8766D 0.4980242 0.3433269     1     1    19  1.5   NA    NA    0.5
#> Error in gList(structure(list(name = "grill.gTree.27", gp = NULL, vp = NULL, : only 'grobs' allowed in "gList"

# Coords output for geom_point_en() with numeric column
ggplot(mtcars, aes(wt, mpg, colour_inner = carb)) + 
  geom_point_en_test() 
#>           x         y colour_inner PANEL group shape colour_outer size
#> 1 0.3027707 0.4555126            4     1    -1    19          red  1.5
#> 2 0.3620441 0.4555126            4     1    -1    19          red  1.5
#> 3 0.2330374 0.5251451            1     1    -1    19          red  1.5
#> 4 0.4410753 0.4709865            1     1    -1    19          red  1.5
#> 5 0.4933753 0.3665377            2     1    -1    19          red  1.5
#> 6 0.4980242 0.3433269            1     1    -1    19          red  1.5
#>   fill alpha stroke encric
#> 1   NA    NA    0.5     NA
#> 2   NA    NA    0.5     NA
#> 3   NA    NA    0.5     NA
#> 4   NA    NA    0.5     NA
#> 5   NA    NA    0.5     NA
#> 6   NA    NA    0.5     NA
#> Error in gList(structure(list(name = "grill.gTree.41", gp = NULL, vp = NULL, : only 'grobs' allowed in "gList"

# Coords output for geom_point_en() with non-numeric column
ggplot(mtcars, aes(wt, mpg, colour_inner = factor(carb))) + 
  geom_point_en_test() 
#>           x         y colour_inner PANEL group shape colour_outer size
#> 1 0.3027707 0.4555126            4     1     4    19          red  1.5
#> 2 0.3620441 0.4555126            4     1     4    19          red  1.5
#> 3 0.2330374 0.5251451            1     1     1    19          red  1.5
#> 4 0.4410753 0.4709865            1     1     1    19          red  1.5
#> 5 0.4933753 0.3665377            2     1     2    19          red  1.5
#> 6 0.4980242 0.3433269            1     1     1    19          red  1.5
#>   fill alpha stroke encric
#> 1   NA    NA    0.5     NA
#> 2   NA    NA    0.5     NA
#> 3   NA    NA    0.5     NA
#> 4   NA    NA    0.5     NA
#> 5   NA    NA    0.5     NA
#> 6   NA    NA    0.5     NA
#> Error in gList(structure(list(name = "grill.gTree.55", gp = NULL, vp = NULL, : only 'grobs' allowed in "gList"

Created on 2018-04-02 by the reprex package (v0.2.0).

I have not yet worked how this is occurring. The panel_parems object is a complicated list and the docs say "You should consider this an opaque data structure: don't look inside it". I have and found nothing that might transform colour values. I am also not convinced that I have the right transform() function and that there might be some internal ggplot2 stuff I havn't found yet occurring.