R/geom-point-upper-lower.R

In houyunhuang/ggtriangle: Fast processing of matrix heatmap

#' Upper and lower points geom
#' @inheritParams ggplot2::geom_point
#' @importFrom ggplot2 layer
#' @rdname geom_point
#' @export
geom_point_upper <- 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 = GeomPointUpper,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    ),
    check.aes = FALSE
  )
}
#' @rdname geom_point
#' @importFrom ggplot2 layer
#' @export
geom_point_lower <- 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 = GeomPointLower,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    ),
    check.aes = FALSE
  )
}
#' @importFrom ggplot2 ggproto GeomPoint
#' @export
GeomPointUpper <- ggproto(
  "GeomPointUpper", GeomPoint,
  draw_panel = function(self, data, panel_params, coord) {
    if(!is.null(data$fill.upper)) {
      data$fill <- data$fill.upper
    }
    if(!is.null(data$colour.upper)) {
      data$colour <- data$colour.upper
    }
    aesthetics <- setdiff(names(data), c("fill.upper", "colour.upper"))
    GeomPoint$draw_panel(data[aesthetics], panel_params, coord)
  },
  default_aes = aes(colour = "black", fill = NA, colour.upper = NULL, fill.upper = NULL,
                    shape = 19, size = 1.5, alpha = NA, stroke = 0.5),
  draw_key = draw_key_point_upper
  )
#' @importFrom ggplot2 ggproto GeomPoint
#' @export
GeomPointLower <- ggproto(
  "GeomPointLower", GeomPoint,
  draw_panel = function(self, data, panel_params, coord) {
    if(!is.null(data$fill.lower)) {
      data$fill <- data$fill.lower
    }
    if(!is.null(data$colour.lower)) {
      data$colour <- data$colour.lower
    }
    aesthetics <- setdiff(names(data), c("fill.lower", "colour.lower"))
    GeomPoint$draw_panel(data[aesthetics], panel_params, coord)
    },

  default_aes = aes(colour = "black", fill = NA, colour.lower = NULL, fill.lower = NULL,
                    shape = 19, size = 1.5, alpha = NA, stroke = 0.5),
  draw_key = draw_key_point_lower
  )