Initial Configuration

Author: nicholasehamilton

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,3 @@
+.Rproj.user
+.Rhistory
+.RData

DESCRIPTION

@@ -0,0 +1,43 @@
+Package: ggtern
+Type: Package
+Title: An extension to ggplot, to create ternary plots
+Version: 1.0
+Date: 2013-11-15
+Author: Nicholas Hamilton
+Maintainer: Nicholas Hamilton <[email protected]>
+Description: More about what it does (maybe more than one line)
+License: GPL-2
+Depends:
+  ggplot2(>= 0.9.3.1),
+  proto,
+  grid,
+  scales,
+  plyr,
+  gtable
+Collate:
+  'element_ternary.R'
+  'utilities.R'
+  'theme.R'
+  'transformTernToCart.R'
+  'labs.R'
+  'aes.R'
+  'scales.R'
+  'geom_point_tern.R'
+  'geom_point_tern_new.R'
+  'geom_text_tern.R'
+  'geom_path_tern.R'
+  'geom_polygon_tern.R'
+  'geom_segment_tern.R'
+  'ternborder.R'
+  'ternbackground.R'
+  'ternlabels.R'
+  'ternfixedcoords.R'
+  'ternarrows.R'
+  'terngridlines.R'
+  'ternticks.R'
+  'ggtern.R'
+  'plot-build.R'
+  'panel.R'
+  'chull_tern.R'
+  'onLoad.R'
+  'tern-render.R'

NAMESPACE

@@ -0,0 +1 @@
+exportPattern("^[[:alpha:]]+")

R/aes.R

@@ -0,0 +1,45 @@
+
+
+#' Modified Aesthetic Mappings
+#' 
+#' An extension to the base aes functin from ggplot2, this is modified to handle a default z mapping for application in ternary phase diagrams.
+#' Does not alter the standard behaviour. 
+#' @param x x value
+#' @param y y value
+#' @param z z value
+#' @seealso Parent \code{\link[ggplot2]{aes}} function.
+aes <- function(x,y,z=NULL,...) {
+  aes <- structure(as.list(match.call()[-1]), class="uneval")
+  ggplot2:::rename_aes(aes)
+}
+
+.aes_hack <- function(){
+  # Look up the scale that should be used for a given aesthetic
+  #aes_to_scale <- function(var) {
+  #  var[var %in% c("x", "xmin", "xmax", "xend", "xintercept")] <- "x"
+  #  var[var %in% c("y", "ymin", "ymax", "yend", "yintercept")] <- "y"
+  #  var[var %in% c("T", "Tmin", "Tmax", "Tend", "Tintercept")] <- "T"
+  #  var[var %in% c("L", "Lmin", "Lmax", "Lend", "Lintercept")] <- "L"
+  #  var[var %in% c("R", "Rmin", "Rmax", "Rend", "Rintercept")] <- "R"
+  #  var
+  #}
+  #unlockBinding("aes_to_scale", asNamespace("ggplot2"))
+  #  assign("aes_to_scale", aes_to_scale, asNamespace("ggplot2"))
+  #lockBinding("aes_to_scale", asNamespace("ggplot2"))
+  
+  # Figure out if an aesthetic is a position aesthetic or not
+  #is_position_aes <- function(vars) {
+  #  aes_to_scale(vars) %in% c("x", "y","T","L","R")
+  #}
+  #unlockBinding("is_position_aes", asNamespace("ggplot2"))
+  #  assign("is_position_aes", is_position_aes, asNamespace("ggplot2"))
+  #lockBinding("is_position_aes", asNamespace("ggplot2"))
+  
+  
+  .all_aesthetics <- ggplot2:::.all_aesthetics
+  .all_aesthetics <- c(.all_aesthetics,"T","L","R","zend")
+  #PUSH BACK.
+  unlockBinding(".all_aesthetics", asNamespace("ggplot2"))
+    assign(".all_aesthetics", .all_aesthetics, asNamespace("ggplot2"))
+  lockBinding(".all_aesthetics", asNamespace("ggplot2"))
+}

R/chull_tern.R

@@ -0,0 +1 @@
+chull_tern <- function(T,L,R,data=data.frame(T=T,L=L,R=R)){chull(transformTernToCart(data=data))}

R/element_ternary.R

@@ -0,0 +1,13 @@
+element_ternary <- function(showarrows =TRUE,
+                            padding    =0.15,
+                            arrowsep   =0.10,
+                            arrowstart =0.25,
+                            arrowfinish=0.75,
+                            ticklength.major =0.020,
+                            ticklength.minor =0.010){
+  structure(
+    list(padding=padding,arrowsep=arrowsep,showarrows=showarrows,arrowstart=arrowstart,arrowfinish=arrowfinish,
+         ticklength.major=ticklength.major,ticklength.minor=ticklength.minor),
+    class = c("element_ternary")
+  )
+}

R/geom_path_tern.R

@@ -0,0 +1,25 @@
+#----------------------------------------
+#PROTO FOR GEOM POINT TERN
+#----------------------------------------
+geom_path_tern <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", na.rm = FALSE, ...) {
+  GeomPathTern$new(mapping = mapping, data = data, stat = stat, position = position, na.rm = na.rm, ...)
+}
+GeomPathTern <- proto(ggplot2:::Geom,{
+  objname <- "path_tern"
+  draw_groups <- function(. ,...){ .$draw(...) }
+  draw <- function(., data, scales, coordinates, arrow = NULL, lineend = "butt", linejoin = "round", linemitre = 1, ..., na.rm = FALSE) {  
+    data <- remove_missing(data,na.rm,c("x","y","z"),name = "geom_path_tern")
+    if (empty(data)) return(zeroGrob())
+    data[,c("x","y")] <- transformTernToCart(data=data[,c("x","y","z")])
+    ggplot2:::GeomPath$draw(.=., data=data, scales=scales, coordinates=coordinates,arrow = arrow, lineend = lineend, linejoin = linejoin, linemitre = linemitre, ..., na.rm = na.rm)
+  }
+  draw_legend <- function(., data, ...) {
+    ggplot2:::GeomPath$draw_legend(.,data,...)
+  }
+  default_stat <- function(.) StatIdentity
+  required_aes <- c("x","y","z")
+  default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA,fill=NA)
+  guide_geom <- function(.) "path"
+})
+
+

R/geom_point_tern.R

@@ -0,0 +1,22 @@
+#----------------------------------------
+#PROTO FOR GEOM POINT TERN
+#----------------------------------------
+geom_point_tern <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", na.rm = FALSE, ...){
+  GeomPointTern$new(mapping = mapping, data = data, stat = stat, position = position, na.rm = na.rm, ...)
+}
+GeomPointTern <- proto(ggplot2:::Geom,{
+  objname <- "point_tern"
+  draw_groups <- function(. ,...){.$draw(...)}
+  draw <- function(.,data, scales, coordinates, ... ,na.rm = FALSE) {
+    data <- remove_missing(data,na.rm,c("x","y","z"),name = "geom_point_tern")
+    if (empty(data)) return(zeroGrob())
+    data[,c("x","y")] <- transformTernToCart(data=data[,c("x","y","z")])
+    ggplot2:::GeomPoint$draw(.=.,data=data,scales=scales,coordinates=coordinates,...,na.rm=na.rm)
+  }
+  draw_legend <- function(., data, ...) {
+    ggplot2:::GeomPoint$draw_legend(.=.,data=data,...)
+  }
+  default_stat <- function(.) StatIdentity
+  required_aes <- c("x","y","z")
+  default_aes <- function(.) aes(shape=16,colour="black",size=2,fill = NA,alpha = NA)
+})

R/geom_point_tern_new.R

@@ -0,0 +1,22 @@
+#----------------------------------------
+#PROTO FOR GEOM POINT TERN
+#----------------------------------------
+geom_point_tern_new <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", na.rm = FALSE, ...){
+  GeomPointTernNew$new(mapping = mapping, data = data, stat = stat, position = position, na.rm = na.rm, ...)
+}
+GeomPointTernNew <- proto(ggplot2:::Geom,{
+  objname <- "point_tern"
+  draw_groups <- function(. ,...){.$draw(...)}
+  draw <- function(.,data, scales, coordinates, ... ,na.rm = FALSE) {
+    data <- remove_missing(data,na.rm,c("T","L","R"),name = "geom_point_tern")
+    if (empty(data)) return(zeroGrob())
+    data[,c("x","y")] <- transformTernToCart(data=data[,c("T","L","R")])
+    ggplot2:::GeomPoint$draw(.=.,data=data,scales=scales,coordinates=coordinates,...,na.rm=na.rm)
+  }
+  draw_legend <- function(., data, ...) {
+    ggplot2:::GeomPoint$draw_legend(.=.,data=data,...)
+  }
+  default_stat <- function(.) StatIdentity
+  required_aes <- c("T","L","R")
+  default_aes <- function(.) aes(shape=16,colour="black",size=2,fill = NA,alpha = NA)
+})