geom_sigmoid_area test

gistfile1.txt

library(ggbump)
library(tidyverse)

# ** StatSigmoidArea ------------------------------------------------------------------

StatSigmoidArea <- ggplot2::ggproto("StatSigmoidArea", ggplot2::Stat,
                                setup_data = function(data, params) {
                                  data <- data %>%
                                    dplyr::group_by(PANEL) %>%
                                    dplyr::mutate(group = dplyr::row_number()) %>%
                                    as.data.frame()
                                  data
                                },
                                compute_group = function(data, scales, smooth) {
                                  out1 <- sigmoid(data$x, data$xend, data$y1, data$y1end,
                                                 smooth = smooth)
                                  out2 <- sigmoid(data$xend, data$x, data$y2end, data$y2,
                                                 smooth = smooth)
                                  dplyr::bind_rows(out1, out2)
                                },

                                required_aes = c("x", "xend", "y1", "y2", "y1end", "y2end")
)

# ** geom_sigmoid_area -----------------------------------------------------------------
#' @title geom_sigmoid_area
#'
#' @param mapping provide you own mapping. both x, xend, y and yend need to be numeric.
#' @param data provide you own data
#' @param geom xhange geom
#' @param position change position
#' @param na.rm remove missing values
#' @param show.legend show legend in plot
#' @param smooth how much smooth should the curve have? More means steeper curve.
#' @param inherit.aes should the geom inherits aestethics
#' @param ... other arguments to be passed to the geom
#'
#' @return ggplot layer
#'
#' @examples
#' library(ggplot2)
#' df <- data.frame(x = 1:6,
#'        y = 5:10,
#'        xend = 7,
#'        yend = -3:2)
#'
#' ggplot(df, aes(x = x, xend = xend, y = y, yend = yend, color = factor(x))) +
#'   geom_sigmoid()
#'
#' @export
geom_sigmoid_area <- function(mapping = NULL, data = NULL, geom = "polygon",
                         position = "identity", na.rm = FALSE, show.legend = NA,
                         smooth = 8, inherit.aes = TRUE, ...) {
  ggplot2::layer(
    stat = StatSigmoidArea, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, smooth = smooth, ...)
  )
}



# EXAMPLE ----------------------------------------------------------------------

df <- tibble (x = 0, xend = 1, y1 = 0, y2 = .7, y1end = .9, y2end = 1.2) %>%
  add_row(x = 1, xend = 2, y1 = 1.15, y2 = 1.2, y1end = 1.9, y2end = 2.1) %>%
  add_row(x = 1, xend = 2, y1 = .9, y2 = 1.15, y1end = 0, y2end = .08) %>%
  add_row(x = 2, xend = 3, y1 = 2, y2 = 2.1, y1end = 2.97, y2end = 3.03) %>%
  add_row(x = 2, xend = 3, y1 = 1.9, y2 = 2, y1end = .9, y2end = 1.1) %>%
  add_row(x = 3, xend = 4, y1 = .9, y2 = 1.1, y1end = 1.95, y2end = 2.05) %>%
  add_row(x = 4, xend = 5, y1 = 1.95, y2 = 2.05, y1end = 2.99, y2end = 3.01) %>%

  add_row(x = 0, xend = 1, y1 = 0, y2 = -.2, y1end = -.9, y2end = -1.1) %>%
  add_row(x = 1, xend = 2, y1 = -1, y2 = -1.1, y1end = -1.9, y2end = -2.1) %>%
  add_row(x = 1, xend = 2, y1 = -.9, y2 = -1, y1end = -0, y2end = -.01) %>%
  add_row(x = 2, xend = 3, y1 = -2, y2 = -2.1, y1end = -2.99, y2end = -3.01) %>%
  add_row(x = 2, xend = 3, y1 = -1.9, y2 = -2, y1end = -.9, y2end = -1.1) %>%
  add_row(x = 3, xend = 4, y1 = -.9, y2 = -1.1, y1end = -1.98, y2end = -2.02)

ggplot(df, aes(x = x, xend = xend, y1 = y1, y2 = y2, y1end = y1end, y2end = y2end)) +
  geom_sigmoid_area(smooth = 8, color = "gray40", size = 1, fill = "gray40") +
  theme_void() +
  theme(panel.grid.major.y = element_line(color = "gray92"))

ggsave("tst.png", dpi = 800)