R/class_layer.R

In ggedit: Interactive 'ggplot2' Layer and Theme Aesthetic Editor

#' @title class_layer
#' @description Determines the class of the arguments in a gg layer.
#' @param p ggplot
#' @return data.frame
#' @keywords internal
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_name quo_squash
#' @importFrom  purrr map2_chr map2_dbl
#' 
class_layer <- function(p){

  if('tbl' %in% class(p$data) ) 
    p$data <- data.frame(p$data)

  plot_aes <- layer_aes <- VAR <- NULL
  
  if( length(as.character(p$mapping))>0 ){
    
  plot_aes <- sapply(p$mapping,rlang::quo_name)
  
  aes_nm <- names(p$mapping)[plot_aes!='NULL']
  
  plot_aes <- plot_aes[plot_aes!='NULL']
  
  plot_aes <- data.frame(VAR=unlist(plot_aes),stringsAsFactors = FALSE)
  
  plot_aes$aes <- aes_nm
  
  plot_cl <- lapply(plot_aes$aes,function(x){
    
    TEMP <- p$data |> 
      dplyr::mutate(.NEWVAR = !!rlang::quo_squash(p$mapping[[x]]))
    
    class(TEMP[['.NEWVAR']])

    })
    
  chkIdx <- which(unlist(lapply(plot_cl, length)) != 1)
  
  for( i in chkIdx ){
    
    if( 'data.frame'%in%plot_cl[[i]] ){
      
      plot_cl[[i]] <- 'data.frame'
      
    }else{
      
      break(sprintf('classes:c(%s) for plot variable:%s. Please choose one and rerun',paste0(plot_cl[[i]],collapse=','), plot_aes$VAR[i]))
      
    }
    
  }
  
  plot_aes$class <- unlist(plot_cl)[1]
  
  plot_aes$layer <- 'plot'
  
  }
  
  layer_aes <- lapply(p$layers,function(x) {
    mappings <- x$mapping
    data.frame(VAR = if(is.null(mappings)) character() else sapply(mappings, quo_name),
               aes = if(is.null(mappings)) character() else names(x$mapping), stringsAsFactors = FALSE)  |> 
      dplyr::filter(!is.null(!!rlang::sym('VAR')))
    
  })
  
  layer_data <- lapply(p$layers,function(x) {
    
             dOut <- x$data
             
             if('tbl' %in% class(dOut))
               dOut <- data.frame(dOut, stringsAsFactors = FALSE)
             
             dOut
             
  })

  pData <- lapply(p$layers, function(l, d) l$layer_data(d), p$data)
    
  names(pData) <- names(layer_aes) <- names(layer_data) <- geom_list(p)
  
  pData$plot <- p$data
  
  layer_aes <- dplyr::bind_rows(layer_aes, .id = 'layer')

  layer_aes <- layer_aes |>
    dplyr::mutate(
      class = purrr::map2_chr(layer, VAR, ~class(pData[[which(grepl(.x, names(pData)))]][[.y]]))
    )

  layer_bind <- rbind(plot_aes, layer_aes)
  
  layer_bind <- layer_bind |>
    dplyr::mutate(
      level.num = purrr::map2_dbl(layer, VAR, ~length(unique(pData[[which(grepl(.x, names(pData)))]][[.y]])))
    )

  return(layer_bind)
}