.packageName <- "DescribeDisplay"
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/axis-geom.r"
require(ggplot2)

#' GeomAxis
#' A special ggplot2 geom for drawing the tour axes
#' 
#' @keywords internal
#' @param Geom previous information
#' @param new function to set up the axis
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @aliases geom_axis
#' @examples
#' print(ggplot(dd_example("tour2d")))
GeomAxis <- proto(Geom, {
  new <- function(., data=NULL, stat=NULL, position=NULL, ...){
    do.call("layer", list(mapping=NULL, data=data, stat=stat, geom=., position=position, ..., inherit.aes = FALSE))
  }
  
  draw <- function(., data, scales, coordinates, location = c(0.2, 0.2), size=0.9, colour = "black", ...) {
    axesVp <- axesViewport(data, location)
    axes <- axesGrob(data, gp=gpar(col = colour))
    
    gTree(
      children = gList(axes), 
      childrenvp = axesVp
    )    
  }

  objname <- "axis"
  icon <- function(.) {}
  desc <- "Projection axes"
  
  default_stat <- function(.) StatIdentity
  required_aes <- c()
  default_aes <- function(.) aes()
  
})

#' Geom Axis
#' A special ggplot2 geom for drawing the tour axes
#' 
#' @param ... should include data, location, aes\_string information
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal
#' @aliases GeomAxis
geom_axis <- function(...) GeomAxis$new(...)
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/axis-grob.r"
#' Axes grob
#' Construct grob for axes.
#' 
#' @param axes describe display object
#' @param gp arguments to the axes
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
axesGrob <- function(axes, gp=gpar(col="black")) {
  if (is.null(axes)) return()

  if (!is.null(axes$y)) { # 2d tour 
    #bigaxes <- subset(as.data.frame(axes), r > 0.3)
    print(axes)
    bigaxes <- axes[axes[,"r"] > 0.3,]
    
    gTree(children=gList(
      circleGrob(0, 0, 1, default.units="native", gp=gpar(fill="transparent", col="black")),
      segmentsGrob(0,0, axes$x, axes$y, default.units="native"),
      textGrob(bigaxes$label, 1.1 * cos(bigaxes$theta), 1.1 * sin(bigaxes$theta), default.units="native")
    ), name="axis", vp=vpPath("axes"), gp=gp)  

  } else { # 1d tour  
    n <- nrow(axes)

    gTree(children=gList(
      rectGrob(),
      linesGrob(x=unit(c(0,0), "native"), y = unit(c(0,1), "npc")),
      segmentsGrob(-1, 1:n , 1, 1:n, default="native", gp=gpar(lty=3)),
      segmentsGrob(0, 1:n , axes$x, 1:n, default="native", gp=gpar(lwd=2)),
      textGrob(-1:1, -1:1, -0.3, default="native", just=c("centre", "top"), gp=gpar(cex=0.9)),
      textGrob(axes$label, 1.1, 1:n, default="native", just=c("left", "centre"))
      
    ), name="axis", vp=vpPath("axes"), gp=gp)
  }
}

#' Axes viewport
#' Construct viewport for axes.
#' 
#' @param axes describe display object
#' @param axislocation location of axes (as x and y position in npc coordinates, ie. between 0 and 1)
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
axesViewport <- function(axes, axislocation) {
  if (is.null(axes)) return()

  if (!is.null(axes$y)) { # 2d tour 
    viewport(xscale=c(-1,1), yscale=c(-1,1), name="axes", width=0.2, height=0.2, x=axislocation[1], y=axislocation[2], default.units="snpc")
  } else { # 1d tour 
    n <- nrow(axes)
    viewport(xscale=c(-1,1), yscale=c(0, n + 1), name="axes", width=0.1, height=unit(n+1, "lines"), x=axislocation[1], y=axislocation[2])
  }
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/data.r"
#' Load describe display
#' Retrieve output of from describe display plugin
#' 
#' Also performs some conversion of data structures to more 
#' conveient form so that other functions do not have to repeatedly
#' recompute.  Some of these conversions could probably be moved into 
#' the Describe Display plugin, but it may be easier to just do them
#' on the R side..
#' 
#' @param path file path
#' @return object of class dd
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @seealso \code{\link{dd_example}} for an easier way of loading example
#'   files
#' @keywords  manip
dd_load <- function(path) {
  dd <- source(path)$value
  class(dd) <- c(dd_plot_class(dd$type), "dd")
  dd$colormap$foreground <- sapply(dd$colormap$foregroundColors, 
    function(x) do.call(rgb, as.list(x))
  )
  dd$colormap$foregroundColors <- NULL
  cols <- nulldefault(dd$ncols, 1)
  dd$dim <- c(dd$nplots / cols, cols)
  dd$plots <- lapply(1:dd$nplots, function(n) dd_clean_plot(dd, n))  
  
  dd
}

#' Load example describe display file
#' Load example describe display file included with package.
#' 
#' These are mainly used for testing.
#' 
#' @param name name of example
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal
#' @examples
#' a <- dd_example("xyplot")
dd_example <- function(name) {
  file <- paste(name, ".r", sep = "")
  path <- system.file("examples", file, package = "DescribeDisplay")
  
  if (!file.exists(path)) {
    stop("Cannot find example ", name, call. = FALSE)
  }
  
  dd_load(path)
}

#' Clean plot data structure
#' Cleans up plot data structure into consistent, easy to use data structure
#' 
#' @param dd dd object
#' @param n plot number
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
dd_clean_plot <- function(dd, n=1) {
  names(dd$plots[[n]]) <- gsub("plot", "", names(dd$plots[[n]]))
  plot <- c(
    list(
      points = dd_points(dd, n),
      edges = dd_edges(dd, n)
    ), 
    dd$plots[[n]][c("type","projection", "params")]
  )

  if (!is.null(plot$projection)) {
    plot$baseline <- if(plot$projection == "1D plot") 0 else (min(plot$points$y) - 0.05 * abs(min(plot$points$y)))    
  }
  
  if (identical(dd$plots[[n]]$scale, c(0.7, 0.7))) {
    plot$xscale <- expand_range(range(plot$points$x), 0.1)
    plot$yscale <- expand_range(range(plot$points$y), 0.1)
  } else if (!is.null(dd$plots[[n]]$tformLims) & sum(dd$plots[[n]]$tformLims[1:2]) == 0 ) {
    plot$xscale <- range(dd$plots[[n]]$planarLims[1:2])
    plot$yscale <- range(dd$plots[[n]]$planarLims[3:4])

    if (diff(plot$yscale) == 0 ) plot$yscale <- expand_range(range(plot$points$y), 0.1) ; print("THIRD")

  } else {
    plot$xscale <- dd$plots[[n]]$tformLims[1:2]
    plot$yscale <- dd$plots[[n]]$tformLims[3:4]
  }

  if (!is.null(dd$plots[[n]]$stickylabels)) {
    labels <- do.call(rbind, lapply(dd$plots[[n]]$stickylabels, as.data.frame))
    labels <- cbind(plot$points[labels$index+1, c("x", "y")], label = labels$label)
    rl <- (labels$x - plot$xscale[1]) / diff(plot$xscale) < 0.5
    tb <- (labels$y - plot$yscale[1]) / diff(plot$yscale) < 0.5
    labels$left <- ifelse(rl, 0, 1)
    labels$top <-  1 #ifelse(tb, 0, 1)
    
    labels$x <- labels$x + (-1 + 2 * rl) * 0.01 * diff(plot$xscale)
    #labels$y <- labels$y + (-1 + 2 * tb) * 0.01 * diff(plot$yscale)
    plot$labels <- labels    
  }

  class(plot) <- c(plot$type, dd_plot_class(plot$projection), "ddplot")

  plot
}

#' Describe display points data
#' Retrieves the describe display points data for the given plot number.
#' 
#' @param dd list of values from describe display 
#' @param n plot number, defaults to first plot
#' @return data frame suitable for plotting
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
dd_points <- function(dd, n=1) {
  df <- as.data.frame(dd$plots[[n]]$points)
  df$hidden <- df$hidden != 0
  cmap <- dd$colormap$foreground
  hiddencolour <- do.call(rgb,as.list(dd$colormap$hiddenColor))
  # Remap point aesthetics to R appropriate values
  df$col <- factor(ifelse(df$hidden, hiddencolour, cmap[df$color + 1]), levels = c(rev(cmap), hiddencolour))

  if(is.null(df$glyphtype))
    df$pch <- df$cex <- rep(1, nrow(df))
  else
  {
    df$pch <- c(18, 3, 4, 1, 0, 16, 15)[df$glyphtype + 1]
    df$cex <- (df$glyphsize + 1)/6
  }
  
  rownames(df) <- nulldefault(df$index, 1:nrow(df))
  
  df[order(!df$hidden), intersect(names(df), c("x","y", "col","pch", "cex", "hidden"))]
}

#' Describe display edge data
#' Retrieves the describe display edge data for the given plot number.
#' 
#' @param dd list of values from describe display 
#' @param n plot number, defaults to first plot
#' @return data frame suitable for plotting
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
dd_edges <- function(dd, n=1) {
  if (is.null(dd$plots[[n]]$edges)) return()
  df <- do.call(rbind, lapply(dd$plots[[n]]$edges, as.data.frame))
  
  # Remap edge aesthetics to appropriate values
  df$col <- dd$colormap$foreground[df$color + 1]
  df$lwd <- (df$lwd + 1)/2
  df$lty <- rep(1,6)[df$ltype + 1]
  
  df <- df[!df$hidden, c("src","dest", "col","lwd", "lty")] # Return only visible edges
  points <- dd_points(dd, n)
  src <- points[as.character(df$src), c("x","y")]
  names(src) <- c("src.x", "src.y")
  dest <- points[as.character(df$dest), c("x","y")]
  names(dest) <- c("dest.x", "dest.y")
  
  cbind(src, dest, df)
}

#' Describe display plot class
#' Compute valid R class name for given plot type
#' 
#' @param projection type of projection that should be used
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
dd_plot_class <- function(projection) {
  gsub("\\s+", "", tolower(projection))
}

#' Describe display plot defaults
#' Gather overall plot defaults for specified plot
#' 
#' @param dd list of values from describe display 
#' @param n plot number, defaults to first plot
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
dd_defaults <- function(dd, n=1) {
  list(
    main = dd$title,
    xlab = nulldefault(dd$plots[[n]]$plotparams$xlab, ""),
    ylab = nulldefault(dd$plots[[n]]$plotparams$ylab, ""),
    axes = FALSE
  )  
}

#' Describe display tour axis
#' Return representation of axes for specified plot
#' 
#' @param plot list of information of a plot
#' @author Hadley Wickham h.wickham [at] gmail.com
#' @keywords internal 
dd_tour_axes <- function(plot) {
  if (is.null(plot$params[["F"]])) return()


  if (plot$projection == "1D Tour") {
    proj <- matrix(plot$params[["F"]], ncol=1)
    colnames(proj) <- "x"
  } else {
    proj <- matrix(plot$params[["F"]], ncol=2, byrow=FALSE)
    colnames(proj) <- c("x","y")
  }

  lbls <- plot$params$labels

  ranges <- do.call(rbind,  plot$params$ranges)
  df <- data.frame(proj, label=lbls, range=ranges)

  if (plot$projection == "2D Tour") {
    df$r <- with(df, sqrt(x^2 + y^2))
    df$theta <- atan2(df$y, df$x)
  } else {
    df <- df[nrow(df):1, ]
  }
  
  df
}

#' Print dd object
#' Use str to print out human readable describe display object
#' 
#' @param x dd object
#' @param ... not used
#' @author Hadley Wickham h.wickham [at] gmail.com
#' @keywords internal 
print.dd <- function(x, ...) str(x)
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/DescribeDisplay-package.r"
# ' R interface to DescribeDisplay (GGobi plugin)
# ' 
# ' \tabular{ll}{ 
# ' Package: \tab DescribeDisplay\cr
# ' Type: \tab Package\cr
# ' Version: \tab 2.0\cr
# ' Date: \tab 2009-04-1\cr
# ' License: \tab BSD\cr
# ' LazyData: \tab true\cr
# ' }
# '
# ' Produce publication quality graphics from output of GGobi's describe display plugin
# '
# ' @name DescribeDisplay-package
# ' @aliases DescribeDisplay
# ' @docType package
# ' @title Tests pseudoprimality by Fermat ' s little theorem
# ' @author Hadley Wickham \email{hadley@@iastate.edu}, Di Cook \email{dicook@@iastate.edu}, Andreas Buja \email{buja@@wharton.upenn.edu}, Barret Schloerke \email{bigbear@iastate.edu}
# ' @depends R (>= 2.6.1), grid, reshape (>= 0.7.1), ggplot2 (>= 0.8.3), proto
# ' @references
# ' \url{http://www.ggobi.org/describe-display}
# ' \url{http://www.ggobi.org/}
# ' \url{http://www.had.co.nz/ggplot2/}
# ' @keywords package
NA
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/ggplot-barchart.r"
#' Create a nice plot for Histograms
#' Create a nice looking plot complete with axes using ggplot.
#' 
#' @param data plot to display, object created by \code{dd_load()}
#' @param spine (not implemented currently) whether to display the barchart as a spine plot
#' @param ... arguments passed through to the ggplot function
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords hplot
#' @S3method ggplot histogram
#' @examples
#' print(ggplot(dd_example("barchart")))
ggplot.histogram <- function(data, spine = FALSE,...) {
#  cat("\nggplot.histogram\n")
  
  p <- ggplot(data$points, 
    aes_string(x = "x", fill = "col",...)) + 
      scale_x_continuous(data$params$label)+
      coord_flip() +
      scale_size_identity() + 
      scale_shape_identity() + 
      scale_linetype_identity() +
      scale_fill_identity()
  
  
#  if(spine){
#    ## not correct yet
#    p <- p + geom_bar( position = "fill", binwidth = diff(data$params$breaks[1:2]) , ...)
#    cat("\nspine\n")
#  }else{
    allBreaks <- c(data$params$breaks,data$params$breaks[length(data$params$breaks)] + diff(data$params$breaks[1:2]))

    p <- p + geom_histogram(breaks = allBreaks,...)
#  }

  p
}




#' Create a nice plot for Bar Plots
#' Create a nice looking plot complete with axes using ggplot.
#' 
#' @param data plot to display, object created by \code{dd_load()}
#' @param spine (not implemented currently) whether to display the barchart as a spine plot
#' @param ... arguments passed through to the ggplot function
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords hplot
#' @S3method ggplot barplot
#' @examples
#' print(ggplot(dd_example("barchart-species")))
ggplot.barplot <- function(data,spine=FALSE,...){
#  cat("\nggplot.barplot\n")
  levelnames <- data$params$levelnames
  levelNameOrder <- data$params$levelvalues + 1
  xVals <- data$points$x
  for(i in 1:length(levelnames)){
    xVals[xVals==i] <- levelnames[levelNameOrder[i]]
  }

  data$points$splitBy <- xVals
#print(unique(data$points$splitBy))
  temp <- unique(data$points$splitBy)

  p <- ggplot(data$points, aes_string(x = "splitBy", fill = "col", ...)) + 
    geom_bar() + 
    coord_flip() +
    scale_x_discrete(data$params$label, limits=c(temp)) +
    scale_size_identity() + 
    scale_shape_identity() + 
    scale_linetype_identity() +
    scale_fill_identity() #+
#    xlim(temp)
    

#	scale_x_continuous(data$params$label, limits = c(unique(data$points$splitBy)) )+


  p
}      
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/ggplot-parcoords.r"
#' Compact pcp data
#' A parallel coordinates is written out as a series of 1D dotplots.  This function
#' compacts it back into one dataset.
#' 
#' @param data data to pull points from
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
compact_pcp <- function(data) {
  ldply(data$plots, function(p) {
    data.frame(
      id = 1:nrow(p$points),
      variable = p$params$label, 
      p$points[c("col", "pch", "cex")], 
      x = nulldefault(p$points$y, 1),
      y = p$points$x
    )
  })
}

#' Scale the values by range
#' Divide the values of the objects by the range of values
#' 
#' @param x values to be worked on
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
range01 <- function(x) {
  rng <- range(x, na.rm = TRUE)
  if (diff(rng) == 0) {
    rep(0, length(x))
  } else {
    (x - rng[1]) / diff(rng)
  }
}

#' Create a nice plot for parallel coordinates plot
#' Create a nice looking plot complete with axes using ggplot.
#' 
#' @param data plot to display
#' @param absoluteX make the sections proportional horizontally to eachother
#' @param absoluteY make the sections proportional vertically to eachother
#' @param edges boolean value to print edges.  Defaults to TRUE.
#' @param ... arguments passed to the grob function
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords hplot 
#' @S3method ggplot parcoords 
#' @examples
#' print(ggplot(dd_example("pcp")))
#' print(ggplot(dd_example("pcp-ash")))
#' print(ggplot(dd_example("pcp-ash"), edges = FALSE))
#' print(ggplot(dd_example("pcp-ash"),absoluteY = TRUE, edges = FALSE))
#' print(ggplot(dd_example("pcp-texture")))
#' print(ggplot(dd_example("pcp-texture"), edges =FALSE))
#' print(ggplot(dd_example("pcp-texture"),absoluteY=TRUE, edges =FALSE))
ggplot.parcoords <- function(
  data,
  absoluteX = FALSE, 
  absoluteY = FALSE, 
  edges = TRUE,
  ...
) { 

  x <- y <- variable <- id <- NULL

  df <- compact_pcp(data)
  
  if (absoluteX) {
    std <- transform(df, x = as.numeric(variable) + range01(x) / 2)  
  } else {
    # Scale variables individually
    std <- ddply(df, .(variable), transform, 
      x = as.numeric(variable) + range01(x) / 2)    
  }
  
  if (!absoluteY) {
    std <- ddply(std, .(variable), transform, y = range01(y))
  }

  ybreaks <- seq(min(df$y), max(df$y), length = 5)
  vars <- levels(df$variable)

  ### Make a pretty picture
  p <- ggplot(std, aes(x, y, group = id, colour = col, order = col)) +
    scale_colour_identity() + 
    scale_size_identity() + 
    scale_shape_identity() + 
    scale_linetype_identity() + 
    opts(title = data$title) +
    scale_y_continuous("", breaks = ybreaks, labels = "") + 
    scale_x_continuous("", breaks = 1:length(vars), 
      labels = vars, minor_breaks = FALSE)
  cat("\nDone with GGplot\n")
  if(edges) {
    p <- p + geom_line(aes_string(size = "cex * 2"))
  }
  cat("\nDone with edges\n")

  # Plot points on top
  if (data$showPoints) {
    p <- p + geom_point(aes_string(shape = "pch", size = "cex * 4.5"))
  }
  cat("\nDone with points\n")

  p
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/ggplot-scatmat.r"
#' Compact scatmat data
#' A scatter plot matrix is made from the information from the 1Dplots. This function collects only that data.
#' 
#' @param data
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords internal 
compact_scatmat <- function(data) {
  
  df <- do.call(rbind, lapply(data$plots, function(p){
    if("1dplot" %in% class(p)){
        aes <- p$points[, c("col", "pch", "cex")]
        data.frame(
          aes, 
          value = p$points$x, 
          variable = p$params$label, 
          id = 1:nrow(p$points)
        )
    }
  }))
  
  cast(df, id + ... ~ variable)
}

#' Create a nice plots in a scatter plot matrix
#' Create a nice looking plots in a matrix.  The 1d sections along
#' the diagonal have a smooth density while the values are compared 
#' to eachother within the matrix.
#' 
#' @param data to display
#' @param ... (currently) unused arguments
#' @S3method ggplot timeseries 
#' @examples
#' print(ggplot(dd_example("scattermat-small")))
#' print(ggplot(dd_example("scattermat")) + opts(aspect.ratio=1))
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords hplot 
ggplot.scatmat <- function(data,...){
  #cat("\nggplot.scatmat\n")
  df <- compact_scatmat(data)

  p <- plotmatrix( df[,setdiff(names(df), c("cex","pch","col", "id")) ] ) +
      scale_colour_identity() + 
      scale_size_identity() + 
      scale_shape_identity() + 
      scale_linetype_identity() + 
      opts(title = data$title) +
      scale_y_continuous("") +
      scale_x_continuous("")

  p
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/ggplot-timeseries.r"
#' Compact time series data
#' A time series plot is made from scatterplots with a common x axis.  
#' This function pulls the correct information out of the data.
#' 
#' @param data
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords internal 
compact_timeseries <- function(data){
  dfx <- data.frame(
    data$plots[[1]]$points[,c("col","pch","cex")], 
    value = data$plots[[1]]$points$x, 
    variable = data$plots[[1]]$params$xlabel, 
    id = 1:nrow(data$plots[[1]]$points) 
  )
  
  df <- do.call(rbind, lapply(data$plots, function(p) {
      aes <- p$points[, c("col", "pch", "cex")]
      data.frame(
        aes, 
      value = p$points$y, 
        variable = p$params$ylabel , 
        id = 1:nrow(p$points)
      )
    }))

  df <- cast(df, id + ... ~ variable)
  dfx <- cast(dfx, id + ... ~ variable)
  
  df <- cbind(
    df[,names(df) %in% c("cex","pch","col", "id") ],
     dfx[,setdiff(names(dfx), c("cex","pch","col", "id")) ],
    df[,setdiff(names(df), c("cex","pch","col", "id")) ] 
  )
  colnames(df)[sum(names(df) %in% c("cex","pch","col", "id")) + 1] <- data$plots[[1]]$params$xlabel
  
  return(df)
  
}


#' Create nice plots for a time series
#' Create nice looking plots complete with axes using ggplot.  Produces graphics with a uniform x axis.  
#' 
#' @param data to display
#' @param edges Boolean operator to tell whether to try to force the edges or not.  Will not work to remove the edges.
#' @param ... (currently) unused arguments
#' @author Barret Schloerke \email{bigbear@@iastate.edu}
#' @keywords hplot
#' @S3method ggplot timeseries 
#' @examples
#' print(ggplot(dd_example("pigs")))
#' print(ggplot(dd_example("pigs"),edges=TRUE))
ggplot.timeseries <- function(data, edges = FALSE,...){
  #cat("\nggplot.timeseries\n")
  
  x <- y <- NULL
  
  df <- compact_timeseries(data)

  data.par <- df[,colnames(df) %in% c("cex","pch","col","id") ]

  df <- df[,setdiff(colnames(df),colnames(data.par))]
  
  ## time series, one column no 1d plots
  grid <- expand.grid(x=1, y=1:ncol(df))
    
    grid <- subset(grid, x != y)

  all <- do.call("rbind", lapply(1:nrow(grid), function(i) {
    xcol <- grid[i, "x"]
    ycol <- grid[i, "y"]

    data.frame(
      xvar = names(df)[ycol], 
      yvar = names(df)[xcol],
      x = df[, xcol], y = df[, ycol], df,data.par
    )
  }))



  all$xvar <- factor(all$xvar, levels=names(df))
  all$yvar <- factor(all$yvar, levels=names(df))
  
    aesString <- aes_string(x="x", y="y",group="xvar")
  class(aesString) <- "uneval"

  p <- ggplot(all, aesString) + facet_grid(xvar ~ yvar, scales = "free") + 
    scale_colour_identity() + 
      scale_size_identity() + 
      scale_shape_identity() + 
      scale_linetype_identity() + 
      opts(title = data$title) +
      scale_x_continuous(all[1,"yvar"]) +
      scale_y_continuous("")+
      geom_point(data = all, aes_string(size = "cex * 4",colour="col", shape = "pch")) +
      opts(title = data$title)
    
  
  if(data$showDirectedEdges | data$showUndirectedEdges | edges == TRUE)
    p <- p + geom_path(data = all, aes_string(x = "x", y = "y", size = "cex", colour = "col"))

  p
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/ggplot.r"
#' Create a nice plot
#' Create a nice looking plot complete with axes using ggplot.
#' 
#' @param data plot to display, object created by \code{dd_load()}
#' @param axis.location grob function to use for drawing
#' @param ... arguments passed to the grob function
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords hplot
#' @S3method ggplot ddplot
#' @examples
#' 
#' print(ggplot(dd_example("tour2d")))
#' print(ggplot(dd_example("tour1d")))
#' print(ggplot(dd_example("tour2d-cube3")))
#' print(ggplot(dd_example("dot")))
#' print(ggplot(dd_example("dot-labels")))
#' print(ggplot(dd_example("xyplot")))
#' print(ggplot(dd_example("xyplot")) + opts(aspect.ratio = 1))
#' print(ggplot(dd_example("xyplot")) + xlab(NULL) + ylab(NULL))
#' print(ggplot(dd_example("ash")))
#' print(ggplot(dd_example("ash")) + geom_segment(aes(x=x,xend=x,y=0,yend=y),size=0.3))
ggplot.ddplot <- function(data, axis.location = c(0.2, 0.2), ...) {
#  cat("\nggplot.ddplot\n")
#print(head(data$points))
  p <- ggplot(data$points, 
    aes_string(x = "x", y = "y", shape = "pch", size = "cex * 6", colour = "col")) +
    scale_colour_identity() + 
    scale_size_identity() + 
    scale_shape_identity() + 
    scale_linetype_identity() +
    scale_x_continuous(
      if(TRUE %in% (c("2dtour", "1dtour") %in% class(data) ) )
        name = ""
      else if(TRUE %in% (c("1dplot") %in% class(data) ) )
        name = data$params$label 
      else 
        name = data$params$xlab,
      limits = data$xscale) + 
    scale_y_continuous(
      if(TRUE %in% (c("2dtour", "1dtour","1dplot") %in% class(data) ) )
        name = "" 
      else
        name = data$params$ylab,
      limits = data$yscale) + 
    geom_point() 

  if("1dplot" %in% class(data))
    p <- p + opts(axis.text.y = theme_blank() )
  
  axes <- dd_tour_axes(data)
  if (!is.null(axes)) {
print("axes")
    #Only is performed if it has tour data
    vars <- names(axes)
    names(vars) <- vars
    
    ## Following three lines are to remove errors.
    axes$pch <- rep(1,length(axes$x))
    axes$cex <- rep(2/5,length(axes$x))
    axes$colour <- rep("black",length(axes$x))
    
#    print(axes)
#	print(str(axes))

    p <- p + 
      geom_axis(data = axes, location = axis.location) +
      opts(axis.text.x = theme_blank(), axis.text.y = theme_blank(), 
        aspect.ratio = 1)
  }

  edges <- data$edges
  if (!is.null(edges)) {
    p <- p + geom_segment(
      aes_string(x = "src.x", y = "src.y", xend = "dest.x", yend = "dest.y",
      linetype = "lty", shape = "NULL", size = "lwd"), data = edges
    )
  }

  
  if (!is.null(data$labels)) {
    ## Following three lines are to remove errors.
    data$labels$pch <- rep(1,length(data$labels$x))
    data$labels$cex <- rep(2/5,length(data$labels$x))
    data$labels$colour <- rep("black",length(data$labels$x))
    p <- p + geom_text(data=data$labels, aes_string(x = "x", y = "y", label = "label"),  justification=c(data$labels$left[1], data$labels$top[1]))
  }  

  p
}


#' Create a nice plot
#' Create a nice looking plot complete with axes using ggplot.
#' 
#' @param data plot to display, object created by \code{dd_load()}
#' @param ... not used
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords hplot
#' @S3method ggplot dd
#' @examples
#' print(example(ggplot.ddplot))
#' print(example(ggplot.histogram))
#' print(example(ggplot.barplot))
ggplot.dd <- function(data, ...) { 
#  cat("\nggplot.dd\n")
  panel <- data$plots[[1]]
  ggplot(panel, ...) + opts(title = data$title)
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/plots.r"
#' Draw dd plot
#' Draw a complete describe display.
#' 
#' If you want to layout multiple dd plots on the same page, you can
#' use \code{\link[grid]{grid.layout}}.  If you need even more control,
#' set \code{draw = FALSE} and then \code{\link[grid]{grid.draw}} the 
#' resulting grob yourself.
#' 
#' This function reads a number of options directly out of the 
#' descripedisplay datastructure.  See the examples for ways to use
#' these.
#' 
#' @param x dd object to plot
#' @param ... (unused)
#' @param draw draw plot, or just return grob
#' @param axislocation location of axes (as x and y position in npc coordinates, ie. between 0 and 1)
#' @param size size of plot as a proportion of the total display area (set to 1 for printed out)
#' @param axisgp color of the axis
#' @param background.color color of in the background of the plot
#' @return frame grob containing all panels, note that this does not contain the title or border
#' @examples
#' plot(dd_example("dot"))
#' plot(dd_example("xyplot"))
#' plot(dd_example("tour1d"))
#' plot(dd_example("tour2d"))
#'
#' ash <- dd_example("ash")
#' plot(ash)
#' ash$plots[[1]]$drawlines <- TRUE
#' plot(ash)
#' ash$plots[[1]]$showPoints <- FALSE
#' plot(ash)
#'
#' texture <- dd_example("1d-texture")
#' plot(texture)
#' texture$plots[[1]]$yscale <- expand_range(texture$plots[[1]]$yscale, 0.5)
#' plot(texture)
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
plot.dd <- function(x, ..., draw = TRUE, axislocation = c(0.1, 0.1), size=0.9, axisgp=gpar(col="black"), background.color="grey90") {
  d <- x$dim
  layout <- grid.layout(nrow = d[1], ncol = d[2])
  panels <- frameGrob(layout = layout)
  
  for(i in 1:x$nplot) {
    panels <- placeGrob(panels, 
      ddpanelGrob(x$plots[[i]], axislocation=axislocation, axis.gp=axisgp, background.color=background.color), 
      col = (i - 1) %/% d[1] + 1, row = (i - 1) %% d[1] + 1
    )
  }

  if (!is.null(x$title) && nchar(x$title) != 0) {
    pg <- frameGrob(grid.layout(nrow=2, ncol=1))
    pg <- packGrob(pg, textGrob(x$title, gp=gpar(cex=1.3)), row=1, height=unit(2,"lines"))
    pg <- packGrob(pg, panels, row=2)
  } else {
    pg <- panels
  }

  if (draw) {
    grid.newpage()
    pushViewport(viewport(w = size, h = size))
    grid.draw(pg)
  }
  
  invisible(panels)
}

#' Plot a dd plot
#' Convenient method to draw a single panel.
#' 
#' This is mainly used for bug testing so that you can pull out a single 
#' panel quickly and easily.
#' 
#' @param x object to plot
#' @param ... (not used)
#' @param axislocation location of axes (as x and y position in npc coordinates, ie. between 0 and 1)
#' @param axis.gp frame grob containing all panels, note that this does not contain the title or border
#' @param background.color color of in the background of the plot
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords hplot
#' @examples
#' scatmat <- dd_example("scattermat")
#' plot(scatmat)
#' plot(scatmat$plots[[1]])
#' plot(scatmat$plots[[3]])
#' plot(scatmat$plots[[4]])
plot.ddplot <- function(x, ..., axislocation = c(0.1, 0.1), axis.gp=gpar(col="black"), background.color = "grey90") {
  grid.newpage()
  grob <- ddpanelGrob(x, axislocation = axislocation, axis.gp = axis.gp,
    background.color = background.color)
  grid.draw(grob)  
}


#' Panel grob
#' Construct grob for single panel.
#' 
#' @param panel describe display object
#' @param axis location, x and y position
#' @param axisgp frame grob containing all panels, note that this does not contain the title or border
#' @param background.color color of in the background of the plot
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords internal 
ddpanelGrob <- function(panel, axislocation = c(0.1, 0.1), axis.gp = gpar(col="black"), background.color="grey90") {
  points <- panel$points
  edges <- panel$edges
  
  axes <- dd_tour_axes(panel)
  axesVp <- axesViewport(axes, axislocation)
  grobs <- list(
    rectGrob(gp=gpar(col="grey", fill=background.color))
  )

  if (!is.null(edges))  
    grobs <- append(grobs, list(segmentsGrob(edges$src.x, edges$src.y, edges$dest.x, edges$dest.y, default.units="native", gp=gpar(lwd=edges$lwd, col=as.character(edges$col)))))
  
  if (is.null(panel$showPoints) || panel$showPoints) {
    grobs <- append(grobs, list(pointsGrob(points$x, points$y, pch=points$pch, gp=gpar(col=as.character(points$col)), size=unit(points$cex, "char"))))
  }
  
  if (!is.null(panel$labels)) {
    labels <- panel$labels
    grobs <- append(grobs, list(
      textGrob(as.character(labels$label), labels$x, labels$y, default.units="native",hjust=labels$left, vjust=labels$top)
    ))
  }
  
  grobs <- append(grobs,  list(
    textGrob(nulldefault(panel$params$xlab, ""), 0.99, 0.01, just = c("right","bottom")),
    textGrob(nulldefault(panel$params$ylab, ""), 0.01, 0.99, just = c("left", "top")),
    axesGrob(axes, gp=axis.gp)
  ))

  if (length(panel$params$label) == 1)
    grobs <- append(grobs, list(textGrob(nulldefault(panel$params$label, ""), 0.5, 0.01, just = c("centre", "bottom"))))

  if (!is.null(panel$drawlines) && panel$drawlines) {
    grobs <- append(grobs, list(segmentsGrob(points$x, panel$baseline, points$x, points$y, default.units="native",  gp=gpar(col=as.character(points$col)))))
  }

  
  gTree(
    children = do.call(gList, grobs), 
    vp = dataViewport(
      xscale = panel$xscale,
      yscale = panel$yscale,
      clip = "on"),
    childrenvp = axesVp
  )
}
#line 1 "/private/tmp/RtmpOJxGym/R.INSTALL10d63af1/DescribeDisplay/R/utils.r"
#' Add brush to plot
#' This adds a rectangle to a ggplot plot indicating the brush position.
#'
#' @param plot plot object
#' @param x x position of brush
#' @param y y position of brush
#' @param width width of brush
#' @param height height of brush
#' @param just which corner of brush should be determined by x and y position
#' @param fill fill colour for brush.  Use ggplot-alpha for alpha blending.
#' @param col outline colour of brush
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords hplot
addbrush <- function(plot, x,y, width=0.5, height=0.5, just=c("left", "top"), fill="transparent", col="black") {
  brush <- data.frame(x=x, y=y, width=width, height=height)
  geom_rect(
    aes_string("x", "y", width = "width", height = "height"),
    data = brush, 
    justification=just, fill=fill, colour=col
  )
}

#' Remove hidden points
#' Will remove all hidden points from the plot.
#'
#' @param d ddplot object
#' @author Hadley Wickham \email{h.wickham@@gmail.com}
#' @keywords manip
removehiddens <- function(d) {
  d$plots <- lapply(d$plots, function(dd) {
    dd$points <- dd$points[!dd$points$hidden, ]
    dd
  })
  
  d
}

#' Run All Examples
#' Will run all examples within the package
#' @author Barret Schloerke bigbear@@iastate.edu
#' @keywords hplot
zeeThemAll <- function()
{
	example(ggplot.dd)
	example(ggplot.scatmat)
	example(ggplot.parcoords)
	example(ggplot.timeseries)	
}
