I am generating a function to wrap up my histogram so its generalisable across multiple datasets and scenarios. However, the colour coding for my alternative plots are not working properly.

I think what happens is that my function assigns the colours to the facet variable and not to the assigned variable for color.

For example:

edgeHist <- function(data, x, y = NULL,type=NULL, ...) {
  if (is(y, 'character') & is(..., 'character')) {
    x <- parse(text=x)
    y <- parse(text=y)
    z <- parse(text = ..1)
    gp <-
      ggplot(data, aes(eval(x),
                       group = eval(z)))   stat_summary(
                         aes(
                           y = eval(y),
                           fill = eval(z),
                           color = eval(z)
                         ),
                         fun = 'sum',
                         geom = 'bar',
                         colour = 'black'
                       )   theme_bw()  
      theme(
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        panel.border = element_rect(colour = "black", fill = NA),
        legend.position = "bottom")   
      xlab(substitute(x))   ylab(substitute(y))  
      scale_fill_continuous(name = (title = substitute(z)))
    

    if(is(type, 'character')){
      if(type == 'single'){
      return(gp)
    }else if (type == 'multiple'){
      z2 <- parse(text=...elt(1)[2])
      gp_plus <- gp   facet_wrap(~eval(z2), scales='free') 
      return(gp_plus)
    }
    }
    return(gp)
    
  }else stop('Stop HERE!')
}

edgeHist(mtcars, 'cyl', 'hp',type='multiple',c('cyl', 'am'))

Produces the following:

Whereas, If I take the chunk of code that I am using for multiple plots, such as the following:

gp <-
  ggplot(mtcars, aes(cyl,
                   group = cyl))   stat_summary(aes( y = hp,fill = cyl, color = cyl
                     ),
                     fun = 'sum',geom = 'bar',colour = 'black' )   
  theme_bw()  
  theme(
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    strip.background = element_blank(),
    panel.border = element_rect(colour = "black", fill = NA),
    legend.position = "right")   
  xlab('cyl')   ylab('hp')  
  scale_fill_continuous(name = (title = 'cyl'))   
  facet_wrap(~eval(am), scales='free') 

I get a working plot:

CodePudding user response：

Although your function works with the modification suggested by Bas, you are mixing a combination of base R and tidyverse-type non-standard evaluation. It may be better to stick to the tidyverse style to make use of its succinct syntax, and the ability to pass column names without having to pass them as strings. This also avoids some ambiguity in the way your column arguments are parsed at present.

edgeHist <- function(data, x, y, color, facet_x, facet_y) {
  
    gp <- ggplot(data, aes({{x}}, group = {{color}}))   
      stat_summary(aes(y = {{y}}, fill = {{color}}),
                   fun = sum, geom = 'col', colour = 'black')   
      theme_bw()  
      theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        panel.border = element_rect(colour = "black", fill = NA),
        legend.position = "bottom")   
      labs(x = substitute(x), y = substitute(y), fill = substitute(color))
  
  if(missing(facet_x) & missing(facet_y)) return(gp)
  if(missing(facet_y)) return(gp   facet_grid(cols = vars(!!ensym(facet_x))))
  if(missing(facet_x)) return(gp   facet_grid(rows = vars(!!ensym(facet_y))))
  return(gp   facet_grid(rows = vars(!!ensym(facet_y)),
                         cols = vars(!!ensym(facet_x))))
}

This allows, for example:

mtcars %>% edgeHist(cyl, hp, color = cyl, facet_x = am)

Or

mtcars %>% edgeHist(x = cyl, y = hp, color = cyl, facet_x = am, facet_y = gear)

Or even without facets:

iris %>% edgeHist(Sepal.Width, Sepal.Length, color = Species)

Edit

To incorporate a color palette, we could do:

edgeHist <- function(data, x, y, color, facet_x, facet_y, palette) {
  
    gp <- ggplot(data, aes({{x}}, group = {{color}}))   
      stat_summary(aes(y = {{y}}, fill = {{color}}),
                   fun = sum, geom = 'col', colour = 'black')   
      theme_bw()  
      theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        strip.background = element_blank(),
        panel.border = element_rect(colour = "black", fill = NA),
        legend.position = "bottom")   
      labs(x = substitute(x), y = substitute(y), fill = substitute(color))
  
  if(!missing(palette)) gp <- gp   scale_fill_gradientn(colors = palette)
  if(missing(facet_x) & missing(facet_y)) return(gp)
  if(missing(facet_y)) return(gp   facet_grid(cols = vars(!!ensym(facet_x))))
  if(missing(facet_x)) return(gp   facet_grid(rows = vars(!!ensym(facet_y))))
  return(gp   facet_grid(rows = vars(!!ensym(facet_y)),
                         cols = vars(!!ensym(facet_x))))
}

This allows, for example:

mtcars %>% 
  edgeHist(cyl, hp, cyl, facet_x = am, palette = c('red', 'orange', 'green4'))