get_method_inheritance fails if ggproto object has no parents

[ying14]

Thanks for your efforts on this package!
I have found it incredibly helpful.

There seems to be a minor issue with get_method_inheritance when dealing with ggproto objects that happen to have zero parents.

library(ggplot2)
library(ggtrace)

get_method_inheritance(Geom)

Error in ls(envir = x) : invalid 'envir' argument

get_method_inheritance(ggplot2:::ScalesList)

Error in ls(envir = x) : invalid 'envir' argument

I believe the error is occurring because the lapply(all_ggprotos, ...) line expects all_ggprotos to be a list, but that doesn't happen if obj has no parents and x$super() is run zero times:

get_method_inheritance <- function(obj, trim_overriden = TRUE) {
  if (!inherits(obj, "ggproto")) {
    rlang::abort("`obj` must be a ggproto object")
  }
  ggprotos <- class(obj)[seq_len(which(class(obj) == "ggproto") - 1L)]
  n_parents <- length(ggprotos) - 1L
  all_ggprotos <- Reduce(
    function(x, y) x$super(),
    seq_len(n_parents),
    init = obj,
    accumulate = TRUE
  )
  all_methods <- lapply(all_ggprotos, function(x) ls(envir = x))
  if (trim_overriden) {
    all_methods <- Reduce(
      function(child, parent) setdiff(parent, c(child, "super")),
      all_methods,
      init = "",
      accumulate = TRUE)[-1L]
  }
  names(all_methods) <- ggprotos
  rev(all_methods)
}

A small change to the Reduce(...) line helped to avoid the problem:

get_method_inheritance2 <- function(obj, trim_overriden = TRUE) {
  if (!inherits(obj, "ggproto")) {
    rlang::abort("`obj` must be a ggproto object")
  }
  ggprotos <- class(obj)[seq_len(which(class(obj) == "ggproto") - 1L)]
  n_parents <- length(ggprotos) - 1L
  all_ggprotos <- Reduce(
    function(x, y) list(x[[length(x)]]$super()),
    seq_len(n_parents),
    init = list(obj),
    accumulate = TRUE
  )
  all_methods <- lapply(all_ggprotos, function(x) ls(envir = x))
  if (trim_overriden) {
    all_methods <- Reduce(
      function(child, parent) setdiff(parent, c(child, "super")),
      all_methods,
      init = "",
      accumulate = TRUE)[-1L]
  }
  names(all_methods) <- ggprotos
  rev(all_methods)
}

get_method_inheritance2(Geom)

$Geom
 [1] "aesthetics"      "default_aes"     "draw_group"      "draw_key"       
 [5] "draw_layer"      "draw_panel"      "extra_params"    "handle_na"      
 [9] "non_missing_aes" "optional_aes"    "parameters"      "rename_size"    
[13] "required_aes"    "setup_data"      "setup_params"    "use_defaults"   

get_method_inheritance2(ggplot2:::ScalesList)

$ScalesList
[1] "add"                 "clone"               "find"               
[4] "get_scales"          "has_scale"           "input"              
[7] "n"                   "non_position_scales" "scales"    

Anyhow thanks again for the package!

[yjunechoe]

Thanks for the bug report!

Your solution makes good sense to me - and actually I wonder if it's worth just edge-casing top-level ggprotos? It's a bigger change to the function, but saves unnecessary Reduce() call(s):

get_method_inheritance3 <- function(obj, trim_overriden = TRUE) {
  if (!inherits(obj, "ggproto")) {
    rlang::abort("`obj` must be a ggproto object")
  }
  ggprotos <- class(obj)[seq_len(which(class(obj) == "ggproto") - 1L)]
  n_parents <- length(ggprotos) - 1L
  if (n_parents == 0) {
    all_methods <- list(sort(names(obj)))
  } else {
    all_ggprotos <- Reduce(
      function(x, y) x$super(),
      seq_len(n_parents),
      init = obj,
      accumulate = TRUE
    )
    all_methods <- lapply(all_ggprotos, function(x) ls(envir = x))
    if (trim_overriden) {
      all_methods <- Reduce(
        function(child, parent) setdiff(parent, c(child, "super")),
        all_methods,
        init = "",
        accumulate = TRUE)[-1L]
    }
  }  
  names(all_methods) <- ggprotos
  rev(all_methods)  
}

get_method_inheritance3(Geom)
#> $Geom
#>  [1] "aesthetics"      "default_aes"     "draw_group"      "draw_key"       
#>  [5] "draw_layer"      "draw_panel"      "extra_params"    "handle_na"      
#>  [9] "non_missing_aes" "optional_aes"    "parameters"      "rename_size"    
#> [13] "required_aes"    "setup_data"      "setup_params"    "use_defaults"

get_method_inheritance3(GeomSmooth)
#> $Geom
#> [1] "aesthetics"      "draw_layer"      "draw_panel"      "handle_na"      
#> [5] "non_missing_aes" "parameters"      "use_defaults"   
#> 
#> $GeomSmooth
#> [1] "default_aes"  "draw_group"   "draw_key"     "extra_params" "optional_aes"
#> [6] "rename_size"  "required_aes" "setup_data"   "setup_params"

I'm not sure where else get_method_inheritance() fails, so please let me know if I've missed anything here!

[ying14]

That looks good to me.
I was trying to use it programatically to collect ggproto methods.... so I'll let you know if I encounter other issues.
Cheers!

[yjunechoe]

Great! I'll keep the issue open for a bit as I've got a busy week (and just in case anything else comes up) - but I'll close this in a few days!