[Soiltexture-commits] r100 - in pkg/ternaryplot: . R inst/examples man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 28 15:58:55 CET 2014
Author: jmoeys
Date: 2014-03-28 15:58:55 +0100 (Fri, 28 Mar 2014)
New Revision: 100
Added:
pkg/ternaryplot/R/aa00-ternaryplot-package.R
pkg/ternaryplot/R/aa01-ternaryplot-options.R
pkg/ternaryplot/R/aa02-ternaryplot-classes.R
pkg/ternaryplot/R/aa03-ternaryplot-classes-utility.R
pkg/ternaryplot/R/aa04-ternarysystems.R
pkg/ternaryplot/R/aa05-ternarydata.R
pkg/ternaryplot/R/aa06-ternary2xy.R
pkg/ternaryplot/R/aa07-plotUtilities.R
pkg/ternaryplot/R/functionsList.txt
pkg/ternaryplot/R/ternarygrid.R
pkg/ternaryplot/inst/examples/createTernaryGeometry-example.R
pkg/ternaryplot/inst/examples/createTernarySystem-example.R
pkg/ternaryplot/inst/examples/createTernaryVariables-example.R
pkg/ternaryplot/inst/examples/ternaryPlot-example.R
pkg/ternaryplot/man/blrLabels-methods.Rd
pkg/ternaryplot/man/createTernaryGeometry.Rd
pkg/ternaryplot/man/createTernaryGrid-methods.Rd
pkg/ternaryplot/man/createTernaryVariables.Rd
pkg/ternaryplot/man/getTernarySystem.Rd
pkg/ternaryplot/man/listTernarySystem.Rd
pkg/ternaryplot/man/ternary2SpatialPolygonsDataFrame-methods.Rd
pkg/ternaryplot/man/ternary2xy-methods.Rd
pkg/ternaryplot/man/ternaryCheck-methods.Rd
pkg/ternaryplot/man/ternaryClockSwitch.Rd
pkg/ternaryplot/man/ternaryData-methods.Rd
pkg/ternaryplot/man/ternaryGeometry-methods.Rd
pkg/ternaryplot/man/ternaryVariables-methods.Rd
Removed:
pkg/ternaryplot/R/aaa-ternaryplot-classes.R
pkg/ternaryplot/R/ternarySystems.R
pkg/ternaryplot/R/ternaryplot-options.R
pkg/ternaryplot/R/ternaryplot-package.R
pkg/ternaryplot/inst/examples/ternaryGeometry.R
pkg/ternaryplot/inst/examples/ternarySystem.R
pkg/ternaryplot/inst/examples/ternaryVariables.R
pkg/ternaryplot/man/blr2xy-methods.Rd
pkg/ternaryplot/man/ternaryDataTest-methods.Rd
pkg/ternaryplot/man/ternaryGeometry-class.Rd
pkg/ternaryplot/man/ternarySystemGet.Rd
pkg/ternaryplot/man/ternarySystemList.Rd
pkg/ternaryplot/man/ternaryVariables-class.Rd
Modified:
pkg/ternaryplot/DESCRIPTION
pkg/ternaryplot/NAMESPACE
pkg/ternaryplot/NEWS
pkg/ternaryplot/R/onattach.R
pkg/ternaryplot/R/ternaryplot.R
pkg/ternaryplot/man/blrClock-methods.Rd
pkg/ternaryplot/man/blrNames-methods.Rd
pkg/ternaryplot/man/fracSum-methods.Rd
pkg/ternaryplot/man/ternaryArrows-methods.Rd
pkg/ternaryplot/man/ternaryAxisArrows-methods.Rd
pkg/ternaryplot/man/ternaryAxisArrowsBase-methods.Rd
pkg/ternaryplot/man/ternaryBox-methods.Rd
pkg/ternaryplot/man/ternaryGrid-methods.Rd
pkg/ternaryplot/man/ternaryGridBase-methods.Rd
pkg/ternaryplot/man/ternaryLims-methods.Rd
pkg/ternaryplot/man/ternaryPlot-methods.Rd
pkg/ternaryplot/man/ternaryPoints-methods.Rd
pkg/ternaryplot/man/ternarySegments-methods.Rd
pkg/ternaryplot/man/ternarySystem-class.Rd
pkg/ternaryplot/man/ternaryText-methods.Rd
pkg/ternaryplot/man/ternaryTicks-methods.Rd
pkg/ternaryplot/man/ternaryWindow-methods.Rd
pkg/ternaryplot/man/ternaryplot-package.Rd
pkg/ternaryplot/man/tlrAngles-methods.Rd
pkg/ternaryplot/man/tpPar.Rd
pkg/ternaryplot/tests/baseTests.R
Log:
Modified: pkg/ternaryplot/DESCRIPTION
===================================================================
--- pkg/ternaryplot/DESCRIPTION 2014-01-15 13:04:01 UTC (rev 99)
+++ pkg/ternaryplot/DESCRIPTION 2014-03-28 14:58:55 UTC (rev 100)
@@ -1,11 +1,11 @@
Package: ternaryplot
-Version: 0.1.2
-Date: 2014-01-15
+Version: 0.3.0
+Date: 2014-03-28
Title: Ternary plots and ternary classifications.
Author: Julien MOEYS <Julien.Moeys at slu.se>
Maintainer: Julien MOEYS <Julien.Moeys at slu.se>
Description: Ternary plots and ternary classifications.
License: AGPL-3
URL: http://www.slu.se/ckb
-Depends: R (>= 3.0.2), methods
-Suggests:
+Depends: R (>= 3.0.2), sp
+Imports: MASS
Modified: pkg/ternaryplot/NAMESPACE
===================================================================
--- pkg/ternaryplot/NAMESPACE 2014-01-15 13:04:01 UTC (rev 99)
+++ pkg/ternaryplot/NAMESPACE 2014-03-28 14:58:55 UTC (rev 100)
@@ -1,53 +1,102 @@
export("blrClock<-")
+export("blrLabels<-")
export("blrNames<-")
export("fracSum<-")
+export("ternaryGeometry<-")
+export("ternaryVariables<-")
export("tlrAngles<-")
export(.ternaryAxisArrows)
export(.ternaryAxisArrowsBase)
+export(.ternaryClockSwitch)
export(.ternaryGridBase)
+export(.ternaryLims)
export(.ternaryTicks)
-export(blr2xy)
export(blrClock)
+export(blrLabels)
export(blrNames)
+export(createTernaryGeometry)
+export(createTernaryGrid)
+export(createTernaryVariables)
+export(deg2rad)
export(fracSum)
+export(getTernarySystem)
export(getTpPar)
+export(listTernarySystem)
+export(ternary2SpatialPolygonsDataFrame)
+export(ternary2xy)
export(ternaryArrows)
export(ternaryBox)
-export(ternaryDataTest)
+export(ternaryCheck)
+export(ternaryData)
+export(ternaryGeometry)
export(ternaryGrid)
-export(ternaryLims)
export(ternaryPlot)
export(ternaryPoints)
export(ternarySegments)
-export(ternarySystemGet)
-export(ternarySystemList)
export(ternaryText)
+export(ternaryVariables)
export(ternaryWindow)
export(tlrAngles)
export(tpPar)
-exportClasses(ternaryGeometry)
exportClasses(ternarySystem)
-exportClasses(ternaryVariables)
-exportMethods("blrClock<-")
-exportMethods("blrNames<-")
-exportMethods("fracSum<-")
-exportMethods("tlrAngles<-")
-exportMethods(.ternaryAxisArrows)
-exportMethods(.ternaryAxisArrowsBase)
-exportMethods(.ternaryGridBase)
-exportMethods(.ternaryTicks)
-exportMethods(blr2xy)
-exportMethods(blrClock)
-exportMethods(blrNames)
-exportMethods(fracSum)
-exportMethods(ternaryArrows)
-exportMethods(ternaryBox)
-exportMethods(ternaryDataTest)
-exportMethods(ternaryGrid)
-exportMethods(ternaryLims)
-exportMethods(ternaryPlot)
-exportMethods(ternaryPoints)
-exportMethods(ternarySegments)
-exportMethods(ternaryText)
-exportMethods(ternaryWindow)
-exportMethods(tlrAngles)
+importFrom(MASS,"data,")
+importFrom(MASS,"for")
+importFrom(MASS,and)
+importFrom(MASS,classes)
+importFrom(MASS,classification.)
+importFrom(MASS,classifications.)
+importFrom(MASS,kde2d)
+importFrom(MASS,plots)
+importFrom(MASS,S4)
+importFrom(MASS,ternary)
+importFrom(MASS,Ternary)
+S3method("blrClock<-",ternaryGeometry)
+S3method("blrClock<-",ternarySystem)
+S3method("blrLabels<-",ternarySystem)
+S3method("blrLabels<-",ternaryVariables)
+S3method("blrNames<-",ternarySystem)
+S3method("blrNames<-",ternaryVariables)
+S3method("fracSum<-",ternaryGeometry)
+S3method("fracSum<-",ternarySystem)
+S3method("ternaryGeometry<-",ternarySystem)
+S3method("ternaryVariables<-",ternarySystem)
+S3method("tlrAngles<-",ternaryGeometry)
+S3method("tlrAngles<-",ternarySystem)
+S3method(.ternaryAxisArrows,ternarySystem)
+S3method(.ternaryAxisArrowsBase,ternarySystem)
+S3method(.ternaryGridBase,ternarySystem)
+S3method(.ternaryLims,character)
+S3method(.ternaryLims,ternarySystem)
+S3method(.ternaryTicks,ternarySystem)
+S3method(blrClock,ternaryGeometry)
+S3method(blrClock,ternarySystem)
+S3method(blrLabels,ternarySystem)
+S3method(blrLabels,ternaryVariables)
+S3method(blrNames,ternarySystem)
+S3method(blrNames,ternaryVariables)
+S3method(createTernaryGrid,character)
+S3method(createTernaryGrid,ternarySystem)
+S3method(fracSum,ternaryGeometry)
+S3method(fracSum,ternarySystem)
+S3method(ternary2SpatialPolygonsDataFrame,ternaryPolygons)
+S3method(ternary2xy,character)
+S3method(ternary2xy,ternaryData)
+S3method(ternary2xy,ternarySystem)
+S3method(ternaryArrows,ternarySystem)
+S3method(ternaryBox,ternarySystem)
+S3method(ternaryCheck,ternaryGeometry)
+S3method(ternaryCheck,ternarySystem)
+S3method(ternaryCheck,ternaryVariables)
+S3method(ternaryData,character)
+S3method(ternaryData,ternarySystem)
+S3method(ternaryGeometry,ternarySystem)
+S3method(ternaryGrid,ternarySystem)
+S3method(ternaryPlot,character)
+S3method(ternaryPlot,ternarySystem)
+S3method(ternaryPoints,ternarySystem)
+S3method(ternarySegments,ternarySystem)
+S3method(ternaryText,ternarySystem)
+S3method(ternaryVariables,ternarySystem)
+S3method(ternaryWindow,character)
+S3method(tlrAngles,ternaryGeometry)
+S3method(tlrAngles,ternarySystem)
Modified: pkg/ternaryplot/NEWS
===================================================================
--- pkg/ternaryplot/NEWS 2014-01-15 13:04:01 UTC (rev 99)
+++ pkg/ternaryplot/NEWS 2014-03-28 14:58:55 UTC (rev 100)
@@ -1,3 +1,10 @@
- o version 0.1.0
+
+ package: ternaryplot
+CHANGES IN VERSION 0.3.0
+
+ 2014/03/28 Package converted from S4-classes to S3-classes
+
+CHANGES IN VERSION 0.1.0
+
2013/01/24 Package created
Added: pkg/ternaryplot/R/aa00-ternaryplot-package.R
===================================================================
--- pkg/ternaryplot/R/aa00-ternaryplot-package.R (rev 0)
+++ pkg/ternaryplot/R/aa00-ternaryplot-package.R 2014-03-28 14:58:55 UTC (rev 100)
@@ -0,0 +1,35 @@
+
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+
+
+#'@importFrom MASS kde2d
+
+
+
+#' Ternary plots and ternary classifications.
+#'
+#' Ternary plots and ternary classifications. S4 classes for ternary
+#' data, ternary plots and ternary classification.
+#'
+#' @author Julien Moeys \email{Julien.Moeys@@slu.se}
+#'
+#' Maintainer: Julien Moeys \email{Julien.Moeys@@slu.se}
+#'
+#' @docType package
+#'
+#' @title Ternary plots and ternary classifications
+#'
+#' @keywords package
+#'
+#' @examples
+#' # Examples coming later
+#'
+#' @name ternaryplot-package
+#'
+NULL
Added: pkg/ternaryplot/R/aa01-ternaryplot-options.R
===================================================================
--- pkg/ternaryplot/R/aa01-ternaryplot-options.R (rev 0)
+++ pkg/ternaryplot/R/aa01-ternaryplot-options.R 2014-03-28 14:58:55 UTC (rev 100)
@@ -0,0 +1,422 @@
+
+# +-------------------------------------------------------------+
+# | Package: ternaryplot |
+# | Language: R + roxygen2 inline documentation |
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se> |
+# | License: AGPL3, Affero General Public License version 3 |
+# +-------------------------------------------------------------+
+
+
+
+# ===============================================================
+# Create two environment that will contain the package parameters
+
+# - Backup / reference
+.tpParList <- new.env()
+
+# - User visible container
+tpParList <- new.env()
+
+
+
+# Set some default parameters:
+
+# NON-GRAPHICAL PARAMETERS
+# ========================
+
+.tpParList[[ "testSum" ]] <- TRUE
+
+.tpParList[[ "testRange" ]] <- TRUE
+
+.tpParList[[ "fracSumTol" ]] <- 1/1000
+
+.tpParList[[ "vertices" ]] <- data.frame(
+ "id" = integer(0),
+ "bo" = numeric(0),
+ "le" = numeric(0),
+ "ri" = numeric(0)
+)
+
+.tpParList[[ "classes" ]] <- data.frame(
+ "abbrev" = character(0),
+ "name" = character(0),
+ "verticesId" = I( vector( length = 0, mode = "list" ) ),
+ stringsAsFactors = FALSE
+)
+
+.tpParList[[ "scale" ]] <- data.frame(
+ "bo" = c( 000, 100 ),
+ "le" = c( 000, 100 ),
+ "ri" = c( 000, 100 ),
+ row.names = c( "min", "max" )
+)
+
+.tpParList[[ "okClock" ]] <- list(
+ # # Bottom Left Right
+ "TTT" = c( TRUE, TRUE, TRUE ),
+ "FFF" = c( FALSE, FALSE, FALSE ),
+ "TXF" = c( TRUE, NA, FALSE ),
+ "FTX" = c( FALSE, TRUE, NA )
+ #"XFT" = c( NA, FALSE, TRUE ) # Un-tested
+)
+
+.tpParList[[ "sp" ]] <- TRUE
+
+# GRAPHICAL PARAMETERS
+# ====================
+
+# Plot region (frame)
+# -------------------
+
+.tpParList[[ "plot.bg" ]] <- NA
+
+# Axis
+# ----
+
+.tpParList[[ "ticksAt" ]] <- seq( from = 0, to = 1, by = .1 )
+
+.tpParList[[ "ticksShift" ]] <- 0.025
+
+.tpParList[[ "arrowsShift" ]] <- c( 0.075, 0.125 )
+
+.tpParList[[ "arrowsCoords" ]] <- c( .15, .45, .45, .55 )
+
+.tpParList[[ "arrowsBreak" ]] <- TRUE
+
+.tpParList[[ "axis.line.lwd" ]] <- NULL
+
+# Grid
+# ----
+
+.tpParList[[ "grid.line.col" ]] <- "lightgray"
+
+
+
+
+# tpPar =========================================================
+
+#'Get or set default parameters for the package.
+#'
+#'Get or set default parameters for the package. Notice changes
+#' done to the parameter values are reset everytime the R session
+#' is closed and the package is reloaded.
+#'
+#'
+#'@details
+#' The function has 3 possible, non-exclusive behaviours: \itemize{ \item If
+#' \code{reset=TRUE}, resetting the parameters to their initial values, as
+#' defined in this function. \item (Silently) returning the actual value of the
+#' package parameters. If \code{par=NULL}, all the values are returned. If
+#' \code{par} is a vector of parameter names, their value will be returned.
+#' \item Setting-up the value of some parameters, passing a list of parameter
+#' value to \code{par} OR setting some of the parameters listed above. }
+#'
+#' Notice that when \code{reset=TRUE} and some new parameter values are
+#' provided, the parameters are first reset, and then the new parameter values
+#' are set. If \code{par} is a list, parameters are set first according to
+#' values in \code{par}, and then according to values in the parameters listed
+#' below. This combination is not recommended, but nonetheless possible.
+#'
+#' The actual value of the parameters is stored in (and can be retrieved from)
+#' the environment \code{rspPars}. The default value of the parameters are
+#' stored in the environment \code{rspPars}. Do not use them directly.
+#'
+#'
+#'@param par
+#' Three possible cases: \itemize{ \item If \code{par} is \code{NULL}
+#' (default): All the actual value of the parameters will be silently returned.
+#' \item If \code{par} is a vector of character strings representing parameter
+#' names. The value of the parameters named here will be (silently) returned.
+#' \item If \code{par} is a list following the format \code{tag = value}, where
+#' \code{tag} is the name of the parameter to be changed, and \code{value} is
+#' its new value. Such a list is returned by \code{tpPar()}. Notice that
+#' parameters can also be set indivudually, using the options listed below. }
+#'
+#'@param reset
+#' Single logical. If TRUE, all the parameters will be set to their
+#' default value. Values are reset before any change to the parameter values, as
+#' listed below.
+#'
+#'@param testRange
+#' Single logical. Test if the range of fraction is between 0 and
+#' the expected sum of fractions (1 or 100).
+#'
+#'@param testSum
+#' Single logical. Test if the sum of the 3 fractions is equal to
+#' the expected sum of fractions (1 or 100).
+#'
+#'@param fracSumTol
+#' Single numeric. Tolerance on the sum of the 3 ternary fractions. Overall
+#' tolerance is \code{fracSum * fracSumTol}, where \code{fracSum} is the
+#' expected sum of the 3 ternary fractions, as given by a
+#' \code{\link[ternaryplot]{ternaryGeometry}} or a \code{\link[ternaryplot]{ternarySystem}}.
+#'
+#'@param ticksAt
+#' Vector of numeric. Pre-defined position of the tick-marks for the 3 axis.
+#' Between 0 and 'fracSum' (the sum of the 3 fractions).
+#'
+#'@param ticksShift
+#' Single numeric. Tick-marks 'size', expressed so that
+#' \code{ticksShift * fracSum} is the length of the tick-marks.
+#'
+#'@param arrowsShift
+#' Vector of tow numeric values. Axis' arrows' shift from their
+#' axis, expressed so that \code{arrowsShift * fracSum} is the
+#' start and end point.
+#'
+#'@param vertices
+#' Vertices of a ternary classification (default): a
+#' \code{\link[base]{data.frame}} with 4 columns \code{id},
+#' \code{bo}, \code{le} and \code{ri}, as the identifier and
+#' the the 3 fractions (bottom, left, right) of the vertices.
+#' Each row is a vertex.
+#'
+#'@param classes
+#' Polygons (classes outline) of a ternary classification (default):
+#' a \code{\link[base]{data.frame}} with 3 columns \code{abbrev},
+#' \code{name} and \code{verticesId}, as the abbreviation,
+#' name and identifier of the vertices of each class. Notice
+#' that \code{verticesId} must be a \code{\link[base]{list}} of
+#' vectors, each containing the vertices that define the polygon.
+#' You can use \code{\link[base]{list}}\code{()} to preserve
+#' the list format when defining the \code{\link[base]{data.frame}}.
+#' For example
+#' \code{ data.frame( "abbrev" = "A", "name" = "Aa", "verticesId" = I( list( 1:3 ) ) ) }
+#'
+#'@param scale
+#' Scale-extent of a ternary classification (default): a
+#' \code{\link[base]{data.frame}} with 3 columns \code{bo},
+#' \code{le} and \code{ri}, and 2 rows (\code{min} and \code{max}),
+#' as the min and max of the 3 fractions to be displayed (bottom,
+#' left, right).
+#'
+#'@param okClock
+#' A list of vectors of 3 logical values, with the valid
+#' \code{blrClock} geometries.
+#'
+#'@param sp
+#' Single logical value. If \code{TRUE}, the low-level graphic
+#' functions output a \code{Spatial*} object of the graphical
+#' element that can be reused in later calculations with
+#' \code{\link[sp]{sp}}. If \code{FALSE}, simply returns a
+#' \code{\link[base]{data.frame}} with the x-y coordinates of the
+#' graphical element.
+#'
+#'@param grid.line.col
+#' Single character value representing a color. Color of the
+#' grid-lines added to a ternary plot.
+#'
+#'@param arrowsCoords
+#' Parameters used internally to define axis-arrows location
+#'
+#'@param arrowsBreak
+#' Single logical value. If \code{TRUE}, axis-arrows are 'browken'
+#' (i.e. with the arrow starting parallel to the axis and finishing
+#' toward the axis).
+#'
+#'@param axis.line.lwd
+#' Single numerical value. Line thickness for the axis-lines
+#' (including ticks and arrows)
+#'
+#'@param plot.bg
+#' Single character value representing a color. Fill-color of the
+#' plot region (frame). Set to \code{NA} or \code{"transparemt"}
+#' to suppress color.
+#'
+#'
+#'@return
+#' Returns a partial or complete list of (actual) parameter values, as a
+#' named list.
+#'
+#'@seealso \code{\link{getTpPar}}.
+#'
+#'@export tpPar
+#'
+tpPar <- function(
+ par = NULL,
+ reset = FALSE,
+ testRange,
+ testSum,
+ fracSumTol,
+ vertices,
+ classes,
+ scale,
+ okClock,
+ sp,
+
+ ticksAt,
+ ticksShift,
+ arrowsShift,
+ arrowsCoords,
+ arrowsBreak,
+ grid.line.col,
+ axis.line.lwd,
+ plot.bg
+
+){
+ parList <- names( formals(tpPar) )
+ parList <- parList[ !(parList %in% c( "par", "reset" )) ]
+
+
+ ## (1) Reset the parameter values:
+ if( reset ){
+ v <- as.list( .tpParList )
+ nv <- names( v )
+
+ lapply(
+ X = 1:length(v),
+ FUN = function(X){
+ assign( x = nv[ X ], value = v[[ X ]], envir = tpParList )
+ }
+ )
+
+ rm( nv, v )
+ }
+
+
+ ## (2) Change the parameter values:
+
+ # Get actual parameter values:
+ tpParValues <- as.list( get( x = "tpParList" ) )
+
+ # Case: par is a list of parameters to be set
+ if( is.list( par ) ){
+ parNames <- names( par )
+
+ if( is.null( parNames ) ){
+ stop( "If 'par' is a list, its item must be named." )
+ }
+
+ # Check that all parameters in par exists:
+ testpar1 <- !(parNames %in% names(tpParValues))
+
+ if( any( testpar1 ) ){
+ stop( sprintf(
+ "Some of the parameter names listed in 'par' could not be found: %s.",
+ paste( parNames[ testpar1 ], collapse=", " )
+ ) )
+ }
+
+ # Set the values
+ for( i in parNames ){
+ tpParValues[[ i ]] <- par[[ i ]]
+ }
+ }
+
+ # Set all the individual parameters provided as a function's
+ # argument(s)
+ for( parLabel in parList ){
+ testExpr <- substitute(
+ expr = !missing(theLabel),
+ env = list( theLabel = as.symbol(parLabel) )
+ )
+
+ if( eval( testExpr ) ){
+ tpParValues[[ parLabel ]] <- get( x = parLabel )
+ }
+ }
+
+ # Set the parameter values at once
+ nv <- names( tpParValues )
+ lapply(
+ X = 1:length(tpParValues),
+ FUN = function(X){
+ assign( x = nv[ X ], value = tpParValues[[ X ]], envir = tpParList )
+ }
+ )
+
+
+ ## (3) Return the parameter values:
+
+ # Case: return the value of some parameters:
+ if( is.character(par) & (length(par) != 0) ){
+ # Test that all demanded parameters exists:
+ testpar <- !(par %in% names(tpParValues))
+
+ if( any( testpar ) ){
+ stop( sprintf(
+ "Some of the parameter names listed in 'par' could not be found: %s.",
+ paste( par[ testpar ], collapse=", " )
+ ) )
+ }
+
+ ret <- tpParValues[ par ]
+
+ # Case: return the value of all parameters:
+ }else{
+ ret <- tpParValues
+ }
+
+ return( invisible( ret ) )
+### Returns a partial or complete list of (actual) parameter values,
+### as a named list.
+}
+
+
+
+# getTpPar ======================================================
+
+#'Get a single default parameters for the package.
+#'
+#'Get a single default parameters for the package. Wrapper around
+#' \code{\link{tpPar}}.
+#'
+#'
+#'@param par
+#' See the \code{par} argument in \code{\link{tpPar}}. Notice that if
+#' more than one parameter name is provided, only the first one will be
+#' returned.
+#'
+#'
+#'@return
+#' Return the value of the parameter \code{par}, without the list
+#' container of \code{\link{tpPar}}.
+#'
+#'@export getTpPar
+#'
+getTpPar <- function(
+ par
+){
+ return( tpPar( par = par )[[ 1L ]] )
+}
+
+
+
+# ===============================================================
+# Test that all parameters in '.tpParList' have been included in
+# the function rspParameters()
+
+# List of parameter names:
+parNames <- names( as.list( .tpParList ) )
+
+# List of argument names
+tpParF <- names(formals(tpPar))
+tpParF <- tpParF[ !(tpParF %in% c("par","reset")) ]
+
+# List of parameters handled by tpPar(): do they match with
+# the default parameters?
+testpar <- !(parNames %in% tpParF)
+
+if( any(testpar) ){
+ stop( sprintf(
+ "Some parameters in '.tpParList' are not in names(formals(tpPar)): %s",
+ paste( parNames[ testpar ], collapse = ", " )
+ ) )
+}
+
+# Other way round
+testpar2 <- !(tpParF %in% parNames)
+
+if( any(testpar2) ){
+ stop( sprintf(
+ "Some parameters in names(formals(tpPar)) are not in '.tpParList': %s",
+ paste( tpParF[ testpar2 ], collapse = ", " )
+ ) )
+}
+
+rm( testpar, parNames, testpar2, tpParF )
+
+
+
+# Set the current list of parameters
+tpParList <- list2env( as.list( .tpParList ) )
Added: pkg/ternaryplot/R/aa02-ternaryplot-classes.R
===================================================================
--- pkg/ternaryplot/R/aa02-ternaryplot-classes.R (rev 0)
+++ pkg/ternaryplot/R/aa02-ternaryplot-classes.R 2014-03-28 14:58:55 UTC (rev 100)
@@ -0,0 +1,592 @@
+
+# +-------------------------------------------------------------+
+# | Package: ternaryplot |
+# | Language: R + roxygen2 inline documentation |
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se> |
+# | License: AGPL3, Affero General Public License version 3 |
+# +-------------------------------------------------------------+
+
+
+
+# ternaryCheck =========================================================
+
+#'Check the validity of ternary*-class objects
+#'
+#'Check the validity of ternary*-class objects
+#'
+#'
+#'@param x
+#' A ternary*-class object.
+#'
+#'@param onFailure
+#' A function like \code{\link[base]{stop}} or
+#' \code{\link[base]{warning}} or \code{\link[base]{message}} to
+#' be called if a non-conformity is found.
+#'
+#'@param \dots
+#' Additional parameters passed to specific methods.
+#'
+#'
+#'@rdname ternaryCheck-methods
+#'
+#'@export
+#'
+ternaryCheck <- function(
+ x,
+ ...
+){
+ UseMethod( "ternaryCheck" )
+}
+
+
+
+#'@rdname ternaryCheck-methods
+#'
+#'@method ternaryCheck ternaryGeometry
+#'@S3method ternaryCheck ternaryGeometry
+ternaryCheck.ternaryGeometry <- function(
+ x,
+ onFailure=stop,
+ ...
+){
+ valid <- TRUE
+
+ # Check names:
+ nm <- c( "tlrAngles", "blrClock", "fracSum" )
+ testNames <- nm %in% names( x )
+
+ if( any( !testNames ) ){
+ onFailure( sprintf(
+ "Some items (or item-labels) are missing: %s",
+ paste( nm, collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testNames )
+
+
+ # Check tlrAngles
+ testTlrAngles <-
+ ( length( x[[ "tlrAngles" ]] ) == 3 ) &
+ is.numeric( x[[ "tlrAngles" ]] ) &
+ ( sum( x[[ "tlrAngles" ]] ) == 180 )
+
+
+ if( !testTlrAngles ){
+ onFailure( sprintf(
+ "'tlrAngles' must be 3 numerical values summing to 180 degrees (now %s)",
+ paste( x[[ "tlrAngles" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testTlrAngles )
+
+
+ # Check blrClock:
+ testBlrClock <-
+ ( length( x[[ "blrClock" ]] ) == 3 ) &
+ is.logical( x[[ "blrClock" ]] )
+
+ if( !testBlrClock ){
+ onFailure( sprintf(
+ "'blrClock' must be 3 logical values (now %s)",
+ paste( x[[ "blrClock" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testBlrClock )
+
+
+ okClock <- getTpPar( "okClock" )
+
+ okClock <- unlist( lapply(
+ X = okClock,
+ FUN = function( X ){
+ identical( x[[ "blrClock" ]], X )
+ }
+ ) )
+
+ if( !any(okClock) ){
+ onFailure( "Invalid 'blrClock'. See getTpPar( 'okClock' ) for accepted values." )
+
+ valid <- FALSE
+ }; rm( okClock )
+
+
+
+ # Check fracSum
+ testFracSum <-
+ ( length( x[[ "fracSum" ]] ) == 1 ) &
+ is.numeric( x[[ "fracSum" ]] ) &
+ all( x[[ "fracSum" ]] %in% c( 1, 100 ) )
+
+ if( !testFracSum ){
+ onFailure( sprintf(
+ "'fracSum' must be 1 numerical values, either 1 or 100 (now %s)",
+ paste( x[[ "fracSum" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testFracSum )
+
+
+ return( valid )
+}
+
+
+
+#'@rdname ternaryCheck-methods
+#'
+#'@method ternaryCheck ternaryVariables
+#'@S3method ternaryCheck ternaryVariables
+ternaryCheck.ternaryVariables <- function(
+ x,
+ onFailure=stop,
+ ...
+){
+ valid <- TRUE
+
+ # Check names:
+ nm <- c( "blrNames", "blrLabels" )
+ testNames <- nm %in% names( x )
+
+ if( any( !testNames ) ){
+ onFailure( sprintf(
+ "Some items (or item-labels) are missing: %s",
+ paste( nm, collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testNames )
+
+
+ # Check blrNames
+ testBlrNames <-
+ ( length( x[[ "blrNames" ]] ) == 3 ) &
+ is.character( x[[ "blrNames" ]] )
+
+
+ if( !testBlrNames ){
+ onFailure( sprintf(
+ "'blrNames' must be 3 character strings (now %s)",
+ paste( x[[ "blrNames" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testBlrNames )
+
+
+ # Check blrLabels
+ testBlrLabels <-
+ ( length( x[[ "blrLabels" ]] ) == 3 ) &
+ ( class( x[[ "blrLabels" ]] ) %in% c( "character", "expression", "name", "call" ) )
+
+
+ if( !testBlrLabels ){
+ onFailure( sprintf(
+ "'blrLabels' must be an object of class character, expression, name or call and length 3 (now %s)",
+ paste( x[[ "blrLabels" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testBlrLabels )
+
+
+ return( valid )
+}
+
+
+
+#'@rdname ternaryCheck-methods
+#'
+#'@method ternaryCheck ternarySystem
+#'@S3method ternaryCheck ternarySystem
+ternaryCheck.ternarySystem <- function(
+ x,
+ onFailure=stop,
+ ...
+){
+ valid <- TRUE
+
+ # Check names:
+ nm <- c( "ternaryGeometry", "ternaryVariables", "main",
+ "vertices", "classes", "scale" )
+ testNames <- nm %in% names( x )
+
+ if( any( !testNames ) ){
+ onFailure( sprintf(
+ "Some items (or item-labels) are missing: %s",
+ paste( nm[ !testNames ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testNames )
+
+
+ valid <- ternaryCheck( x[[ "ternaryGeometry" ]], onFailure = onFailure, ... )
+ valid <- ternaryCheck( x[[ "ternaryVariables" ]], onFailure = onFailure, ... )
+
+
+ # Check main
+ testMain <-
+ ( length( x[[ "main" ]] ) %in% c(1,0) ) &
+ ( class( x[[ "main" ]] ) %in% c( "character", "expression", "name", "call" ) )
+
+ if( !testMain ){
+ onFailure( sprintf(
+ "'main' must be an object of class character, expression, name or call and length 1 (now %s)",
+ paste( x[[ "main" ]], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testMain )
+
+
+ # Check vertices
+ verticesDefault <- getTpPar( "vertices" )
+
+ cn <- c( colnames(verticesDefault)[1],
+ x[[ "ternaryVariables" ]][[ "blrNames" ]] )
+
+ testCol <- cn %in% colnames( x[[ "vertices" ]] )
+
+ if( !all( testCol ) ){
+ onFailure( sprintf(
+ "Some columns are missing in 'vertices': %s",
+ paste( cn[ !testCol ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testCol )
+
+
+ # Test classes:
+ cn2 <- colnames( getTpPar( "classes" ) )
+
+ testCol <- cn2 %in% colnames( x[[ "classes" ]] )
+
+ if( !all( testCol ) ){
+ onFailure( sprintf(
+ "Some columns are missing in 'classes': %s",
+ paste( cn2[ !testCol ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testCol )
+
+
+ # Test class x vertices
+ verticesId <- unlist( x[[ "classes" ]][, "verticesId" ] )
+ id <- x[[ "vertices" ]][, "id" ]
+ testClaVer <- verticesId %in% id
+
+ if( any( !testClaVer ) ){
+ onFailure( sprintf(
+ "Some classes[, 'verticesId' ] are missing in vertices[, 'id']: %s",
+ paste( verticesId[ !testClaVer ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testClaVer )
+
+
+ testClaVer2 <- id %in% verticesId
+
+
+ if( any( !testClaVer2 ) ){
+ onFailure( sprintf(
+ "Some vertices[, 'id'] are missing in classes[, 'verticesId' ]: %s",
+ paste( id[ !testClaVer2 ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testClaVer2 )
+
+
+ # Test scale:
+ testCol <- cn[ -1 ] %in% colnames( x[[ "scale" ]] )
+
+ if( !all( testCol ) ){
+ onFailure( sprintf(
+ "Some columns are missing in 'scale': %s",
+ paste( cn[ -1 ][ !testCol ], collapse = "; " )
+ ) )
+
+ valid <- FALSE
+ }; rm( testCol )
+
+ testRow <-
+ ( nrow( x[[ "scale" ]] ) == 2L ) &
+ all( c( "min", "max" ) %in% rownames( x[[ "scale" ]] ) )
+
+ if( !testRow ){
+ onFailure( "scale must have two rows, labelled 'min' and 'max'" )
+
+ valid <- FALSE
+ }; rm( testRow )
+
+
+ testDiff <- as.numeric( x[[ "scale" ]][ 2, ] - x[[ "scale" ]][ 1, ] )
+ testDiff <- all( testDiff == testDiff[1] )
+
+ if( any( !testDiff ) ){
+ onFailure( "In 'scale', the difference between min and max must be identica" )
+
+ valid <- FALSE
+ }
+
+
+ return( valid )
+}
+
+
+
+# createTernaryGeometry ============================================
+
+#'Creates a ternaryGeometry object: ternary plot geometry definition.
+#'
+#'Creates a ternaryGeometry object: ternary plot geometry definition.
+#'
+#' In this package, ternary plots geometries are defined by the
+#' 3 triangle's angles (top, left, right), and by the sum of the
+#' 3 fractions it represents (1 if a fraction, and 100 if a
+#' percentage).
+#'
+#'
+#'@param tlrAngles
+#' Vector of numeric. Top, left and right angle (in degrees)
+#' of the ternary diagram. Must sum to 180 degrees.
+#'
+#'@param blrClock
+#' Vector of logical. Bottom, left and right axis directions.
+#' Set to \code{TRUE} if the axis is clockwise, and to
+#' \code{FALSE} if the axis is counter-clockwise.
+#'
+#'@param fracSum
+#' Single numeric. Sum of the three fractions. Must be 1 (if
+#' a fraction) or 100 (if a percentage).
+#'
+#'@param \dots
+#' Additional parameters passed to \code{\link[ternaryplot]{ternaryCheck}}
+#'
+#'
+#'@example inst/examples/createTernaryGeometry-example.R
+#'
+#'
+#'@name createTernaryGeometry
+#'
+#'@export createTernaryGeometry
+#'
+createTernaryGeometry <- function(
+ tlrAngles = c( 60, 60, 60 ),
+ blrClock = rep( TRUE, 3 ),
+ fracSum = 100,
+ ...
+){
+ # Create a ternary geometry object:
+ tg <- list(
+ "tlrAngles" = tlrAngles,
+ "blrClock" = blrClock,
+ "fracSum" = fracSum
+ )
+
+ # Set the class
+ class( tg ) <- "ternaryGeometry"
+
+
+ # Check:
+ ternaryCheck( tg, ... )
+
+
+ return( tg )
+}
+
+
+
+# createTernaryVariables ===========================================
+
+#'Creates a ternaryVariables object: ternary plot variables definitions.
+#'
+#'Creates a ternaryVariables object: ternary plot variables definitions.
+#'
+#' In this package, ternary plots variables are defined by the 3
+#' variables name (bottom, left, right), as they will be found in
+#' \code{\link[base]{data.frame}} containing ternary datasets,
+#' and by the label of these variables on the axis of a ternary
+#' plot.
+#'
+#'
+#'@param blrNames
+#' Vector of characters. Bottom, left and right variable names
+#' as they will be found in \code{data.frame} containing ternary
+#' data.
+#'
+#'@param blrLabels
+#' Vector of characters or vector of expressions. Bottom, left
+#' and right variable labels as they will be displayed on ternary
+#' plots.
+#'
+#'@param \dots
+#' Additional parameters passed to \code{\link[ternaryplot]{ternaryCheck}}
+#'
+#'
+#'@example inst/examples/createTernaryVariables-example.R
+#'
+#'
+#'@name createTernaryVariables
+#'
+#'@export createTernaryVariables
+#'
+createTernaryVariables <- function(
+ blrNames = paste0( "F", 1:3 ),
+ blrLabels = sprintf( "Fraction %s [%s]", 1:3, "%" ),
+ ...
+){
+ tv <- list(
+ "blrNames" = blrNames,
+ "blrLabels" = blrLabels
+ )
+
+ # Set the class
+ class( tv ) <- "ternaryVariables"
+
+
+ # Check:
+ ternaryCheck( tv, ... )
+
+
+ return( tv )
+}
+
+
+
+# createTernarySystem ===========================================
+
+#'Creates a ternarySystem object: ternary plot system definition.
+#'
+#'Creates a ternarySystem object: ternary plot system
+#' definition.
+#'
+#' Ternary systems are a combination of (a) a ternary
+#' geometry (as defined by
+#' \code{\link[ternaryplot]{createTernaryGeometry}}), (b) a set of
+#' ternary variables (as defined by
+#' \code{\link[ternaryplot]{createTernaryVariables}} and an optional
+#' classification system, that is polygons drawn on top of ternary
+#' plots, that define different zones in the fractions.
+#'
+#' The classification is defined by a collection of polygons (in
+#' \code{classes}) with different \code{vertices}.
+#'
+#'
+#'@param ternaryGeometry
+#' A ternary geometry (as defined by
+#' \code{\link[ternaryplot]{createTernaryGeometry}}). If \code{NULL},
+#' use the default output of \code{\link[ternaryplot]{createTernaryGeometry}}.
+#'
+#'@param ternaryVariables
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/soiltexture -r 100
More information about the Soiltexture-commits
mailing list