baptiste

library(proto)
library(grid)

geom_custom <- function (mapping = NULL, data = NULL, stat = "identity",
                         position = "identity", show_guide = FALSE, ...) { 
  GeomCustom$new(mapping = mapping, data = data, stat = stat,
                 position = position, show_guide = show_guide, ...)
}

GeomCustom <- proto(ggplot2:::Geom, {

baptiste

fixedsize <- 
function(p, width=unit(1, "npc"), height=unit(1, "npc"), ...) {
  g <- ggplotGrob(p)
  xtitle <- editGrob(getGrob(g, "axis.title.x.text", grep = TRUE), vp = NULL)
  ytitle <- editGrob(getGrob(g, "axis.title.y.text", grep = TRUE), vp = NULL)
  xlabels <- editGrob(getGrob(g, "axis.text.x.text", grep = TRUE), vp = NULL)
  ylabels <- editGrob(getGrob(g, "axis.text.y.text", grep = TRUE), vp = NULL)
  
  legends <- if (!is.null(g$children$legends)) 

baptiste

library(gtable)

## layout the core cells with top and left headers
align_table <- function(core, top, left, just=c("center", "center")){

  gl <- grid.layout(nrow=2,ncol=2,
                    widths=unit.c(sum(left$widths), sum(core$widths)),
                    heights=unit.c(sum(top$heights), sum(core$heights)),
                    just=just)
  

baptiste

library(gtable)

gcore <- gtable_matrix(name="core",
                       grobs=matrix(list(rectGrob(gp=gpar(fill="blue",alpha=0.5))),1,1),
                       widths=unit(5,"cm"), heights=unit(3,"cm"))

gtop <- gtable_matrix(name="top",
                       grobs=matrix(list(rectGrob(gp=gpar(fill="red",alpha=0.5))),1,1),
                       widths=unit(5,"cm"), heights=unit(1,"cm"))

baptiste

library(gtable)

cbind_gtable <- function(x, y, size = "max") {
  stopifnot(nrow(x) == nrow(y))
  if (ncol(x) == 0) return(y)
  if (ncol(y) == 0) return(x)
  
  y$layout$l <- y$layout$l + ncol(x)
  y$layout$r <- y$layout$r + ncol(x)
  x$layout <- rbind(x$layout, y$layout)

baptiste

library(gtable)

## build a rectGrob with parameters
cellRect <- function(fill) 
   rectGrob(gp=gpar(fill=fill, col=fill))

## fail-safe plotmath parsing
tryparse <- function(lab)
  tryCatch(parse(text=lab), error = function(e) lab)

baptiste

library(gtable)

## build a rectGrob with parameters
cellRect <- function(fill) 
   rectGrob(gp=gpar(fill=fill, col=fill))

## fail-safe plotmath parsing
tryparse <- function(lab)
  tryCatch(parse(text=lab), error = function(e) lab)

baptiste

library(gtable)
library(plyr)
library(tables)

## creates a gtable
## given a header (character matrix, possibly with attributes)
## NAs are used to indicate grobs that span multiple cells
gtable_header <- function(header, n = NULL,
                          type = c("row","col"),
                          fun = textGrob, padding=unit(rep(2,2),"mm"), ...){

baptiste

library(gtable)
library(plyr)

library(methods)

theme <- setRefClass("theme", fields = list( bg = "vector",
                                             fg = "vector",
                                             colours = "vector", 
                                             font = "list",
                                             row_font = "list",

baptiste

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")