R/RAltair.R

In wenyuyangpku/RAltair: A RAltair Function

#' A RAltair Function
#' This function allows you to translate ggplot to vega.
#' @export
#' @examples
#' RAltair()
#' 
RAltair <- function(p) {
  
  data<-p$data
  xlabel <- p$labels$x
  ylabel <- p$labels$y
  weightlabel<-p$labels$weight
  xtype <- "nominal"
  ytype <- "nominal"
  weighttype <- "quantitative"
  if (class(data[[xlabel]]) == "numeric" || class(data[[xlabel]]) == "integer")
    xtype <- "quantitative"
  if (class(data[[ylabel]]) == "numeric" || class(data[[ylabel]]) == "integer")
    ytype <- "quantitative"
  
  
  layer <- "NotAcceptNow"
  
  if (attributes(p$layers[[1]]$geom)$class[1] == "GeomPoint")
    layer <- "GeomPoint"
  
  if (attributes(p$layers[[1]]$geom)$class[1] == "GeomBar")
    layer <- "GeomBar"
  
  if (layer == "GeomPoint") {
    
    if (length(p$layers[[1]]$mapping[[1]][[2]]) > 1) {
      if (p$layers[[1]]$mapping[[1]][[2]][[1]] == "factor") {
        if (attributes(p$layers[[1]]$mapping)$name == "colour")
          data[p$labels$colour] = factor(p$data[[p$layers[[1]]$mapping[[1]][[2]][[2]]]])
        if (attributes(p$layers[[1]]$mapping)$name == "shape")
          data[p$labels$shape] = factor(p$data[[p$layers[[1]]$mapping[[1]][[2]][[2]]]])
        if (attributes(p$layers[[1]]$mapping)$name == "size")
          data[p$labels$size] = factor(p$data[[p$layers[[1]]$mapping[[1]][[2]][[2]]]])
      }
    }
    
    
    
    spec_mtcars <-
      list(
        `$schema` = vega_schema(), # specifies Vega-Lite
        width = 500,
        height = 500,
        description = "An mtcars example.",
        data = list(values = data),
        mark = list(type = "point", color = p$layers[[1]]$aes_params$colour,
                    size = p$layers[[1]]$aes_params$size, opacity = p$layers[[1]]$aes_params$alpha,
                    shape = p$layers[[1]]$aes_params$shape),
        encoding = list(
          x = list(field = xlabel, type = xtype,axis=list(labelAngle=0)),
          y = list(field = ylabel, type = ytype),
          color = list(field = p$labels$colour, type = "nominal"),
          size = list(field = p$labels$size, type = "quantitative"),
          opacity = list(field = p$labels$alpha, type = "nominal"),
          shape = list(field = p$labels$shape, type = "nominal")
          
        )
      ) %>%
      as_vegaspec
  }
  
  
  if (layer == "GeomBar") {
    y = list(field = ylabel, type = ytype)
    if (class(p$data[[ylabel]]) == "NULL") {
      y = list(aggregate = ylabel, type = ytype)
    }
    x = list(field = xlabel, type = xtype, axis = list(labelAngle = 0))
    if (weightlabel != "weight") {
      y = list(aggregate = "sum", field = weightlabel, type = weighttype, axis = list(labelAngle = 0))
    }
    spec_mtcars <-
      list(
        `$schema` = vega_schema(), # specifies Vega-Lite
        width = 500,
        height = 500,
        description = "An mtcars example.",
        data = list(values = data),
        mark = list(type = "bar", color = p$layers[[1]]$aes_params$colour),
        encoding = list(
          x = x,
          y=y,
          color = list(field = p$labels$fill, type = "nominal"),
          size = list(field = p$labels$size, type = "quantitative"),
          opacity = list(field = p$labels$alpha, type = "nominal"),
          shape = list(field = p$labels$shape, type = "nominal")
          
        )
      ) %>%
      as_vegaspec
  }
  if (layer == "NotAcceptNow") {
    spec_mtcars <- "The first layer is not point or bar"
  }
  
  spec_mtcars
}