GeomSand

geom_sand.R

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

}


StatSand <- ggproto(
    "StatSand",
    Stat,

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

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

    compute_group = function(data, scales, params) {
        # 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(
            hl = hl,
            vl = vl,
            na.rm = na.rm,
            ...
        )
    )
}

GeomSand <- ggproto(
    "GeomSand",
    Geom,

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

    # draw_key = draw_key_path,


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

    setup_data = function(data, params) {
        # data$xend <- params$vl
        # data$yend <- params$hl
        # print(params)
        # print(data)
        data
    },

    draw_panel = function(data, panel_params, coord, hl, vl){

        # print("Geom:draw_panel")
        # print(panel_params)
        # print(coord)
        coords <- coord$transform(data, panel_params)

        # print(coord$limits)
        # print(panel_params)
        # print(coords)

        panel_params$x.range <- c(-15, 15)
        panel_params$y.range <- c(-15, 15)

        panel_params$y.labels <- c("10", "15")


        v.line <- data.frame(x = vl, xend = vl, y = panel_params$y.range[1], yend = panel_params$y.range[2])
        v.line <- cbind(v.line, head(select(coords, -x, -y), 1))
        v.line$size <- 1
        
        h.line <- data.frame(y = hl, yend = hl, x = panel_params$x.range[1], xend = panel_params$x.range[2])
        h.line <- cbind(h.line, head(select(coords, -x, -y), 1))
        h.line$size <- 1

        grid::gList(
            GeomPoint$draw_panel(data, panel_params, coord)
            # Vertical Line
            , GeomSegment$draw_panel(v.line,
                                        panel_params,
                                        coord)
            # Horizontal Line
            , GeomSegment$draw_panel(h.line,
                                    panel_params,
                                    coord)
        )
    }

)