Sample ggextension

geom_sand.R

stat_sand <- function(mapping = NULL,
                      data = NULL,
                      position = 'identity',
                      na.rm = FALSE,
                      show.legend = NA,
                      inherit.aes = TRUE,
                      hl = NA,
                      vl = NA,
                      ...) {
    layer(
        stat = StatSand,
        geom = GeomSand,
        data = data,
        position = position,
        show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(
            na.rm = na.rm,
            hl = hl,
            vl = vl,
            ...
        )
    )

}


StatSand <- ggproto(
    "StatSand",
    Stat,

    required_aes = c("x", "y"),

    setup_data = function(data, params) {
        data
    },

    compute_group = function(data, scales, params, hl, vl) {
        data <- rbind(
            data,
            data.frame(
                x = 0,
                y = hl,
                PANEL = 1,
                group = "hl"
            ),
            data.frame(
                x = vl,
                y = 0,
                PANEL = 1,
                group = "vl"
            )
        )
        print(data)
        data
    }

)

geom_sand <- function(mapping = NULL,
                      data = NULL,
                      hl = NA,
                      vl = NA,
                      position = "identity",
                      na.rm = FALSE,
                      show.legend = NA,
                      inherit.aes = TRUE,
                      ...) {
    layer(
        stat = StatSand,
        geom = GeomSand,
        data = data,
        mapping = mapping,
        position = position,
        show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(
            na.rm = na.rm,
            hl = hl,
            vl = vl,
            ...
        )
    )
}

GeomSand <- ggproto(
    "GeomSand",
    Geom,

    required_aes = c("x", "y"),


    default_aes = aes(
        fill = NA,
        alpha = 1,
        size = 1,
        stroke = 1,
        linetype = 1,
        colour = 'black',
        shape = 16
    ),

    setup_data = function(data, params) {
        data
    },

    draw_group = function(data, panel_params, coord) {
        if (data$group[[1]] == 'vl') {
            print(data)
            data$y <- panel_params$y.range[1]
            data$yend <- panel_params$y.range[2]
            data$x <- data$x
            data$xend <- data$x
            print(data)
            GeomSegment$draw_panel(data, panel_params, coord)
        } else if (data$group[[1]] == 'hl') {
            data$x <- panel_params$x.range[1]
            data$xend <- panel_params$x.range[2]
            data$y <- data$y
            data$yend = data$y
            print(data)
            GeomSegment$draw_panel(data, panel_params, coord)
        } else{
            GeomPoint$draw_panel(data, panel_params, coord)
        }
    }


)