polygon point shapes

geom-ngon.r

library(proto)
library(ggplot2)
library(grid)


polygon2 <- function(n=5, ang=0, x=0, y=0, rotateFromOrigin=FALSE){
  ## inspired from a post by William Dunlap on r-help (10/09/09)
  if(n<3) stop("n must be more than 3!")
  ## if(n>100) warning("n is limited to 100")
  
  cc <- exp(seq(0, n)*2i*pi/n)
  if(rotateFromOrigin)
    {
    cc <- (cc + complex(x, y)) * exp(1i*ang)
  } else {
    cc <- cc * exp(1i*ang)  + complex(x, y)
  }
  
  cbind(Re(cc), Im(cc))
}


polygon.regular <- function (sides=4, scale.area=TRUE, star=FALSE) { 

n <- sides # lazy to replace
if (n<3) n <- 3 
if (n > 8) n <- 50
# if (n > 8 & star) n <- 8

if(!star){ # convex polygon
  
xy <- polygon2(n)
 if(scale.area) {
	Area = n/2 * 1^2 * sin(2*pi / n)
	xy <- xy / sqrt(Area)
 }

} else { # starred version
xy <- polygon.star(n=sides)
if(scale.area) {
	# unimplemented
  .NotYetImplemented()
}

}
return(xy)
} 


ngonGrob <- function (x, y, sides = 5, size = 1,
                      angle = rep(pi/2, length(x)), 
                      ar = rep(1, length(x)), 
                      gp = gpar(colour = "grey50", fill = "grey90", 
                        linejoin = "mitre"),
                      units.def = "native", units.size="mm") 
{
  stopifnot(length(y) == length(x))
  n <- length(x)
  if (length(size) < n) 
    size <- rep(size, length.out = n)
  if (length(sides) < n) 
    sides <- rep(sides, length.out = n)
  ngonC <- lapply(sides, polygon.regular)
  ngonC.list <- lapply(seq_along(ngonC), function(ii) size[ii] * 
                       ngonC[[ii]] %*%
                       matrix(c(sqrt(ar[ii]), 0, 0, 1/sqrt(ar[ii])), ncol = 2) %*%
                       matrix(c(cos(angle[ii]), -sin(angle[ii]), 
                                sin(angle[ii]), cos(angle[ii])), nrow = 2))
  vertices <- sapply(ngonC.list, nrow)
  reps.x <- do.call(c, lapply(seq_along(x),
                              function(ii) rep(x[ii], vertices[ii])))
  reps.y <- do.call(c, lapply(seq_along(y),
                              function(ii) rep(y[ii], vertices[ii])))
  ngonXY <- do.call(rbind, ngonC.list)
  
  polygonGrob(x = unit(ngonXY[, 1], units.size) + unit(reps.x, units.def), 
              y = unit(ngonXY[, 2], units.size) + unit(reps.y, units.def), 
              default.units = units.def, id.lengths = unlist(vertices), 
              gp = gp)
}


grid.ngon <- function(...)
  {
    grid.draw(ngonGrob(...))
  }


GeomNgon <- proto(ggplot2:::Geom, {
  objname <- "ngon"
  desc <- "Regular polygons"
 
  draw <- function(., data, scales, coordinates, ...) {
    with(coord_transform(coordinates, data, scales), 
         ggplot2:::ggname(.$my_name(), ngonGrob(x, y, sides, size, angle, ar, gp=gpar(col=alpha(colour, alpha), fill = alpha(fill, alpha), lex=lex))))
  }


  required_aes <- c("x", "y")
  default_aes <- function(.) 
	aes(sides=5, size=1, angle=0, ar=1, colour="grey50", fill = NA, alpha = 1, lex=1)
  default_stat <- function(.) StatIdentity
   guide_geom <- function(.) "ngon"
  
  # 

  draw_legend <- function(., data, ...) {
    data <- aesdefaults(data, .$default_aes(), list(...))

    with(data,
	{
		if(angle != 0 && is.na(fill) && ar == 1)
		grob.angle <- segmentsGrob(0.5, 0.5, 0.5 + cos(angle)/2, 0.5 + sin(angle)/2, 
			gp=gpar(colour="grey50", lex=lex))
		else grob.angle <- NULL
      gTree(children = gList(grob.angle, 
              ngonGrob(0.5, 0.5,
                      ar=ar,
                      size=size,
                      sides=sides,
                      angle = angle ,
                      gp=gpar(fill=fill, lex=lex), units.def="npc")))
	}
		)
  }

})


geom_ngon <- function (mapping = NULL, data = NULL, stat = "identity",
                       position = "identity", na.rm = FALSE, ...) {
  GeomNgon$new(mapping = mapping, data = data, stat = stat, position = position, 
  na.rm = na.rm, ...)
}

sides_pal <- function () 
{
    types <- c(3, 4, 5, 6, 7, 8, 50)
    function(n) {
        types[seq_len(n)]
    }
}
scale_sides <- function(...) {
  discrete_scale("sides", "sides", sides_pal(), ...)
}

scale_sides_discrete <- scale_sides

dsmall <- diamonds[sample(nrow(diamonds), 100), ]
str(dsmall)
d <- ggplot(dsmall, aes(carat, price))
d + geom_ngon(aes(colour = carat, angle = x, ar=y, fill=carat), lex=1, sides=50)

d + geom_ngon(aes(fill = depth, sides=cut, size=color),ar=1)


## ggplot(data.frame(x=0, y=0), mapping = aes(x, y ))+ 
## geom_point(size=100, col="red", pch=1)+
## geom_point(size=100, col="red", pch=0)+
## geom_point(size=100, col="red", pch=3)+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=50, col="green")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=3, col="blue")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=4, col="blue")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=5, col="blue")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=6, col="blue")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=7, col="blue")+
## geom_ngon(size=100, fill="yellow", alpha=0.2, sides=8, col="blue")