[Soiltexture-commits] r96 - / pkg pkg/ternaryplot pkg/ternaryplot/R pkg/ternaryplot/inst pkg/ternaryplot/inst/examples pkg/ternaryplot/man prepare
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 9 15:47:07 CET 2014
Author: jmoeys
Date: 2014-01-09 15:47:07 +0100 (Thu, 09 Jan 2014)
New Revision: 96
Added:
pkg/ternaryplot/
pkg/ternaryplot/DESCRIPTION
pkg/ternaryplot/NAMESPACE
pkg/ternaryplot/NEWS
pkg/ternaryplot/R/
pkg/ternaryplot/R/aaa-ternaryplot-classes.R
pkg/ternaryplot/R/onattach.R
pkg/ternaryplot/R/ternarySystems.R
pkg/ternaryplot/R/ternaryplot-options.R
pkg/ternaryplot/R/ternaryplot-package.R
pkg/ternaryplot/R/ternaryplot.R
pkg/ternaryplot/inst/
pkg/ternaryplot/inst/examples/
pkg/ternaryplot/inst/examples/ternaryGeometry.R
pkg/ternaryplot/inst/examples/ternarySystem.R
pkg/ternaryplot/inst/examples/ternaryVariables.R
pkg/ternaryplot/man/
pkg/ternaryplot/man/blr2xy-methods.Rd
pkg/ternaryplot/man/blrClock-methods.Rd
pkg/ternaryplot/man/blrNames-methods.Rd
pkg/ternaryplot/man/deg2rad.Rd
pkg/ternaryplot/man/fracSum-methods.Rd
pkg/ternaryplot/man/getTpPar.Rd
pkg/ternaryplot/man/ternaryArrows-methods.Rd
pkg/ternaryplot/man/ternaryBox-methods.Rd
pkg/ternaryplot/man/ternaryDataTest-methods.Rd
pkg/ternaryplot/man/ternaryGeometry-class.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/ternarySystemGet.Rd
pkg/ternaryplot/man/ternarySystemList.Rd
pkg/ternaryplot/man/ternaryTicks-methods.Rd
pkg/ternaryplot/man/ternaryVariables-class.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/
prepare/ternaryplotSource.R
ternaryplot_1_RCMDbuild.bat
ternaryplot_1_RCMDbuild_novignette.bat
ternaryplot_2_RCMDcheck.bat
ternaryplot_2_RCMDcheck_notests_noexamples_novignettes.bat
ternaryplot_3_RCMDINSTALL_build.BAT
ternaryplot_Document.R
ternaryplot_ToDoList.TXT
ternaryplot_inspiration.txt
ternaryplot_vignette_compile.R
Modified:
pkg/
Log:
Relocated 'ternaryplot' in the 'soiltexture' project
Property changes on: pkg
___________________________________________________________________
Modified: svn:ignore
- *.Rcheck
*.gz
*.zip
soiltexture.Rcheck
soiltexture.Rcheck.zip
soiltexture_1.2.3.tar.gz
soiltexture_1.2.3_R_i486-pc-linux-gnu.tar.gz
soiltexture_1.2.4.tar.gz
soiltexture_1.2.4.zip
soiltexture_1.2.5.tar.gz
soiltexture_1.2.5.zip
soiltexture_1.2.6.tar.gz
soiltexture_1.2.6.zip
soiltexture_1.2.6_R_i486-pc-linux-gnu.tar.gz
soiltexture_1.2.8.tar.gz
soiltexture_1.2.8.zip
soiltexture_1.2.9.tar.gz
soiltexture_1.2.9.zip
+ *.Rcheck
*.gz
*.zip
binaryArchives
soiltexture.Rcheck
soiltexture.Rcheck.zip
soiltexture_1.2.3.tar.gz
soiltexture_1.2.3_R_i486-pc-linux-gnu.tar.gz
soiltexture_1.2.4.tar.gz
soiltexture_1.2.4.zip
soiltexture_1.2.5.tar.gz
soiltexture_1.2.5.zip
soiltexture_1.2.6.tar.gz
soiltexture_1.2.6.zip
soiltexture_1.2.6_R_i486-pc-linux-gnu.tar.gz
soiltexture_1.2.8.tar.gz
soiltexture_1.2.8.zip
soiltexture_1.2.9.tar.gz
soiltexture_1.2.9.zip
Added: pkg/ternaryplot/DESCRIPTION
===================================================================
--- pkg/ternaryplot/DESCRIPTION (rev 0)
+++ pkg/ternaryplot/DESCRIPTION 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,10 @@
+Package: ternaryplot
+Version: 0.1.1
+Date: 2013-06-27
+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.0), methods
Added: pkg/ternaryplot/NAMESPACE
===================================================================
--- pkg/ternaryplot/NAMESPACE (rev 0)
+++ pkg/ternaryplot/NAMESPACE 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,47 @@
+export("blrClock<-")
+export("blrNames<-")
+export("fracSum<-")
+export("tlrAngles<-")
+export(.ternaryGridBase)
+export(.ternaryTicks)
+export(blr2xy)
+export(blrClock)
+export(blrNames)
+export(fracSum)
+export(getTpPar)
+export(ternaryArrows)
+export(ternaryBox)
+export(ternaryDataTest)
+export(ternaryGrid)
+export(ternaryLims)
+export(ternaryPlot)
+export(ternaryPoints)
+export(ternarySegments)
+export(ternarySystemGet)
+export(ternarySystemList)
+export(ternaryWindow)
+export(tlrAngles)
+export(tpPar)
+exportClasses(ternaryGeometry)
+exportClasses(ternarySystem)
+exportClasses(ternaryVariables)
+exportMethods("blrClock<-")
+exportMethods("blrNames<-")
+exportMethods("fracSum<-")
+exportMethods("tlrAngles<-")
+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(ternaryWindow)
+exportMethods(tlrAngles)
Added: pkg/ternaryplot/NEWS
===================================================================
--- pkg/ternaryplot/NEWS (rev 0)
+++ pkg/ternaryplot/NEWS 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,3 @@
+ o version 0.1.0
+
+ 2013/01/24 Package created
Added: pkg/ternaryplot/R/aaa-ternaryplot-classes.R
===================================================================
--- pkg/ternaryplot/R/aaa-ternaryplot-classes.R (rev 0)
+++ pkg/ternaryplot/R/aaa-ternaryplot-classes.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,217 @@
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+
+
+
+#'Class for defining the geometry of a ternary plot
+#'
+#'Class for defining the geometry of a ternary plot. 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).
+#'
+#'
+#'@section Slots:
+#' \describe{
+#' \item{\code{tlrAngles}:}{
+#' Vector of numeric. Top, left and right angle (in degrees)
+#' of the ternary diagram. Must sum to 180 degrees.
+#' }
+#' \item{\code{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.
+#' }
+#' \item{\code{fracSum}:}{
+#' Single numeric. Sum of the three fractions. Must be 1 (if
+#' a fraction) or 100 (if a percentage).
+#' }
+#' }
+#'
+#'
+#'@example inst/examples/ternaryGeometry.R
+#'
+#'
+#'@name ternaryGeometry-class
+#'
+#'@exportClass ternaryGeometry
+#'
+setClass(
+ Class = "ternaryGeometry",
+
+ representation = representation(
+ tlrAngles = "numeric",
+ blrClock = "logical",
+ fracSum = "numeric"
+ ),
+
+ prototype = prototype(
+ tlrAngles = c( 60, 60, 60 ),
+ blrClock = rep( TRUE, 3 ),
+ fracSum = 100
+ )
+
+ #contains = numeric(),
+
+ #validity = function(object){}
+)
+
+
+
+
+#'Class for defining the variables of a ternary plot
+#'
+#'Class for defining the variables of a ternary plot. In this package,
+#' ternary plots variables are defined by the 3 variables name
+#' (bottom, left, right), as they will be found in \code{data.frame}
+#' containing ternary datasets, and by the label of these variables
+#' on the axis of a ternary plot.
+#'
+#'
+#'@section Slots:
+#' \describe{
+#' \item{\code{blrNames}:}{
+#' Vector of characters. Bottom, left and right variable names
+#' as they will be found in \code{data.frame} containing ternary
+#' data.
+#' }
+#' \item{\code{blrLabels}:}{
+#' Vector of characters or vector of expressions. Bottom, left
+#' and right variable labels as they will be displayed on ternary
+#' plots.
+#' }
+#' }
+#'
+#'
+#'@example inst/examples/ternaryVariables.R
+#'
+#'
+#'@name ternaryVariables-class
+#'
+#'@exportClass ternaryVariables
+#'
+setClass(
+ Class = "ternaryVariables",
+
+ representation = representation(
+ blrNames = "character",
+ blrLabels = "vector"
+ ),
+
+ prototype = prototype(
+ blrNames = c( "F1", "F2", "F3" ),
+ blrLabels = c( "Fraction 1 [%]", "Fraction 2 [%]", "Fraction 3 [%]" )
+ ),
+
+ #contains = numeric(),
+
+ validity = function(object){
+ msg <- character(0)
+
+ if( length( object@'blrNames' ) != 3 ){
+ msg <- "'length( blrNames )' must be 3 values"
+ }
+
+ if( length( object@'blrLabels' ) != 3 ){
+ msg <- c( msg, "'sum( blrLabels )' must be 3 values" )
+ }
+
+ testLabelsClass <- !all( class( object@'blrLabels' ) %in%
+ c( "character", "expression", "name", "call" ) )
+
+ if( testLabelsClass ){
+ msg <- c( msg, "'class( blrLabels )' must be 'character' or 'expression'" )
+ }
+
+ if( length(msg) == 0 ){
+ out <- TRUE
+ }else{
+ out <- msg
+ }
+
+ return( out )
+ }
+)
+
+
+
+
+#'Class for defining a ternary classification
+#'
+#'Class for defining a ternary classification. ternary
+#' classification are polygons drawn on top of
+#' ternary plots, that define different zones in the
+#' fractions
+#'
+#'
+#'@section Slots:
+#' \describe{
+#' \item{\code{ternaryGeometry}:}{
+#' An object of class \code{ternaryGeometry}. See
+#' \code{\link{ternaryGeometry-class}};
+#' }
+#' \item{\code{ternaryVariables}:}{
+#' An object of class \code{ternaryVariables}. See
+#' \code{\link{ternaryVariables-class}};
+#' }
+#' \item{\code{main}:}{
+#' Single character string, or single
+#' \code{\link[base]{expression}}. Title of the ternary
+#' plot;
+#' }
+#' }
+#'
+#'
+#'@example inst/examples/ternarySystem.R
+#'
+#'
+#'@name ternarySystem-class
+#'
+#'@exportClass ternarySystem
+#'
+setClass(
+ Class = "ternarySystem",
+
+ representation = representation(
+ ternaryGeometry = "ternaryGeometry",
+ ternaryVariables = "ternaryVariables",
+ main = "vector",
+ vertices = "data.frame",
+ classes = "data.frame",
+ scale = "data.frame"
+ ),
+
+ prototype = prototype(
+ ternaryGeometry = new( "ternaryGeometry" ),
+ ternaryVariables = new( "ternaryVariables" ),
+ main = "Ternary plot",
+ vertices = data.frame(
+ "id" = integer(0),
+ "F1" = numeric(0),
+ "F2" = numeric(0),
+ "F3" = numeric(0)
+ ),
+ classes = data.frame(
+ "abbrev" = character(0),
+ "name" = character(0),
+ "verticesId" = I( vector( length = 0, mode = "list" ) ),
+ stringsAsFactors = FALSE
+ ),
+ scale = data.frame(
+ "F1" = c( 000, 100 ),
+ "F2" = c( 000, 100 ),
+ "F3" = c( 000, 100 ),
+ row.names = c( "min", "max" )
+ )
+ )
+
+ #contains = numeric(),
+
+ #validity = function(object){}
+)
+
Added: pkg/ternaryplot/R/onattach.R
===================================================================
--- pkg/ternaryplot/R/onattach.R (rev 0)
+++ pkg/ternaryplot/R/onattach.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,28 @@
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+
+
+
+.onAttach <- function(# Print a welcome message
+### Print a welcome message.
+
+ libname,
+### See help(".onLoad")
+
+ pkgname
+### See help(".onLoad")
+
+){ #
+ msg <- sprintf(
+ "'%s' package loaded. Type help(package='%s') for examples and help.",
+ pkgname, pkgname )
+
+ packageStartupMessage( msg )
+### Does not return anything.
+} #
+
Added: pkg/ternaryplot/R/ternarySystems.R
===================================================================
--- pkg/ternaryplot/R/ternarySystems.R (rev 0)
+++ pkg/ternaryplot/R/ternarySystems.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,134 @@
+# New environment that will contain the definition of a few
+# ternary classification systems
+ternarySystemEnv <- new.env()
+
+
+# Default, empty, ternary classification:
+ternarySystemEnv[[ "default" ]] <- new( "ternarySystem" )
+
+
+
+
+# Dummy ternary classification:
+ternarySystemEnv[[ "dummy" ]] <- new(
+ "ternarySystem",
+
+ "ternaryGeometry" = new( "ternaryGeometry" ),
+
+ "main" = "Ternary plot (dummy)",
+
+ "vertices" = data.frame(
+ "id" = c( 1, 2, 3, 4),
+ "F1" = c(000, 000, 050, 100),
+ "F2" = c(100, 000, 000, 000),
+ "F3" = c(000, 100, 050, 000)
+ ),
+
+ "classes" = data.frame(
+ "abbrev" = c(
+ "C1",
+ "C2" ),
+ "name" = c(
+ "Class 1",
+ "Class 2" ),
+ "verticesId" = I( list( # The length of each item can vary
+ "C1" = c( 1, 2, 3 ),
+ "C2" = c( 3, 2, 4 )
+ ) ),
+ stringsAsFactors = FALSE
+ ),
+
+ "scale" = data.frame(
+ "F1" = c( 000, 100 ),
+ "F2" = c( 000, 100 ),
+ "F3" = c( 000, 100 ),
+ row.names = c( "min", "max" )
+ )
+)
+
+
+
+
+# HYPRES / EU Soil Map texture triangle
+ternarySystemEnv[[ "HYPRES" ]] <- new(
+ "ternarySystem",
+
+ "ternaryVariables" = new(
+ "ternaryVariables",
+ "blrNames" = c( "SAND", "CLAY", "SILT" ),
+ "blrLabels" = expression(
+ 'Sand 50-2000' ~ mu * 'm [%]',
+ 'Clay 0-2' ~ mu * 'm [%]',
+ 'CSilt 2-50' ~ mu * 'm [%]'
+ )
+ ),
+
+ "ternaryGeometry" = new(
+ "ternaryGeometry",
+ "tlrAngles" = c( 60, 60, 60 ),
+ "blrClock" = rep( TRUE, 3 ),
+ "fracSum" = 100
+ ),
+
+ "main" = "HYPRES / EU Soil Map texture triangle",
+
+ "vertices" = data.frame(
+ "id" = c( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 ),
+ "CLAY" = c( 100, 060, 060, 035, 035, 035, 018, 018, 000, 000, 000, 000 ),
+ "SILT" = c( 000, 000, 040, 000, 050, 065, 000, 017, 000, 035, 085, 100 ),
+ "SAND" = c( 000, 040, 000, 065, 015, 000, 082, 065, 100, 065, 015, 000 )
+ ),
+
+ "classes" = data.frame(
+ "abbrev" = c( "VF", "F", "M", "MF", "C" ),
+ "name" = c(
+ "Very fine",
+ "Fine",
+ "Medium",
+ "Medium fine",
+ "Coarse" ),
+ "verticesId" = I( list(
+ c(02,01,03),
+ c(04,02,03,06),
+ c(07,04,05,11,10,08),
+ c(11,05,06,12),
+ c(09,07,08,10)
+ ) ),
+ stringsAsFactors = FALSE
+ ),
+
+ "scale" = data.frame(
+ "SAND" = c( 000, 100 ),
+ "SILT" = c( 000, 100 ),
+ "CLAY" = c( 000, 100 ),
+ row.names = c( "min", "max" )
+ )
+)
+
+# In fact it is the FAO soil texture classes: Info from SysCan
+# http://sis.agr.gc.ca/cansis/nsdb/lpdb/faotext.html
+# FAO Soil Texture
+# Texture is the relative proportion of sand, silt and clay of the dominant
+# soil for each soil map polygon. Texture classes are:
+#
+# Coarse texture: sands, loamy sand and sandy loams with less than 18 % clay,
+# and more than 65 % sand.
+#
+# Medium texture: sandy loams, loams, sandy clay loams, silt loams with less
+# than 35 % clay and less than 65 % sand; the sand fractions may be as high as 82 % if a minimum of 18 % clay is present.
+#
+# Fine texture: clays, silty clays, sandy clays, clay loams and silty clay loams
+# with more than 35 % clay.
+#
+# Where two or three texture names appear, this means that all named textures
+# are present in the map unit.
+#
+# Texture Codeset
+# COARSE
+# FINE
+# FINE-COARSE
+# FINE-MED-CRS
+# FINE-MEDIUM
+# MEDIUM
+# MEDIUM-COARSE
+
Added: pkg/ternaryplot/R/ternaryplot-options.R
===================================================================
--- pkg/ternaryplot/R/ternaryplot-options.R (rev 0)
+++ pkg/ternaryplot/R/ternaryplot-options.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,292 @@
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+
+
+
+# +-------------------------------------------------------------+
+# Create two environment that will contain the package's
+# parameters.
+
+# - Backup / reference
+.tpParList <- new.env()
+
+# - User visible container
+tpParList <- new.env()
+
+
+
+# Set some default parameters:
+
+#.tpParList[[ "dummy" ]] <- NULL
+.tpParList[[ "testSum" ]] <- TRUE
+.tpParList[[ "testRange" ]] <- TRUE
+.tpParList[[ "fracSumTol" ]] <- 1/1000
+.tpParList[[ "ticksAt" ]] <- seq( from = 0, to = 1, by = .1 )
+.tpParList[[ "ticksShift" ]] <- 0.025
+.tpParList[[ "arrowsShift" ]] <- c( 0.05, 0.10 )
+
+
+
+
+# +-------------------------------------------------------------+
+# Define the function that handles the package default parameters:
+
+#'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{\linkS4class{ternaryGeometry}} or a \code{\linkS4class{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.
+#'
+#'@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,
+ ticksAt,
+ ticksShift,
+ arrowsShift
+){
+ 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.
+}
+
+
+
+
+
+#'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/ternaryplot-package.R
===================================================================
--- pkg/ternaryplot/R/ternaryplot-package.R (rev 0)
+++ pkg/ternaryplot/R/ternaryplot-package.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,31 @@
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+
+
+
+#' 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/ternaryplot.R
===================================================================
--- pkg/ternaryplot/R/ternaryplot.R (rev 0)
+++ pkg/ternaryplot/R/ternaryplot.R 2014-01-09 14:47:07 UTC (rev 96)
@@ -0,0 +1,2843 @@
+# +-------------------------------------------------------------+
+# | Language: R + roxygen2 inline documentation
+# | Package: ternaryplot
+# | Author(s): Julien Moeys <Julien.Moeys@@slu.se>
+# | License: AGPL3, Affero General Public License version 3
+# +-------------------------------------------------------------+
+
+# Useful: \code{} \code{\link[]{}}
+
+
+
+
+#'Fetch a pre-defined ternary classification system
+#'
+#'Fetch a pre-defined ternary classification system
+#'
+#'
+#'@param s
+#' Single character string. Name of the ternary classification to
+#' be fetched.
+#'
+#'
+#'@return
+#' A \code{\linkS4class{ternarySystem}} object.
+#'
+#'
+#'@export
+#'
+ternarySystemGet <- function( s = "default" ){
+ if( !is.character( s ) ){
+ stop( "'s' must be a character string" )
+ }
+
+ # Get all the ternary classifications:
+ # ternarySystemList <- as.list( "ternaryplot":::"ternarySystemList" )
+ ternarySystemE <- as.list( ternarySystemEnv )
+
+ # Check if the system asked is present:
+ if( s %in% names( ternarySystemE ) ){
+ s <- ternarySystemE[[ s ]]
+ }else{
+ stop( sprintf(
+ "The ternary plot (%s) could not be found",
+ s
+ ) )
+ }
+
+ return( s )
+}
+
+
+
+
+#'List all pre-defined ternary classification systems
+#'
+#'List all pre-defined ternary classification systems
+#'
+#'
+#'@return
+#' A vector of character strings, names of the pre-defined ternary
+#' classification systems
+#'
+#'
+#'@export
+#'
+ternarySystemList <- function(){
+ # Get all the ternary classifications:
+ ternarySystemE <- as.list( ternarySystemEnv )
+
+ tsList <- names( ternarySystemE )
+
+ return( tsList )
+}
+
+
+
+
+#'Test the conformity of ternary point data
+#'
+#'Test the conformity of ternary point data according to a
+#' \code{\linkS4class{ternarySystem}} object.
+#'
+#'
+#'@usage
+#' \S4method{ternaryDataTest}{missing}( s, \dots )
+#'
+#' \S4method{ternaryDataTest}{character}( s, \dots )
+#'
+#' \S4method{ternaryDataTest}{ternarySystem}( s, x,
+#' testRange = TRUE, testSum = TRUE, \dots )
+#'
+#'
+#'@param s
+#' A \code{\linkS4class{ternarySystem}} object or a character string
+#' naming a pre-defined \code{ternarySystem}.
+#'
+#'@param x
+#' A \code{\link[base]{data.frame}} or a \code{\link[base]{matrix}}
+#' containing point ternary data (x-y-x) to be tested.
+#'
+#'@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 \dots
+#' Additional parameters passed to \code{ternarySystem-methods}.
+#'
+#'@return
+#' Does not return anything. Stops if an error is found.
+#'
+#'
+#'@rdname ternaryDataTest-methods
+#'
+#'@export
+#'
+#'@docType methods
+#'
+ternaryDataTest <- function(
+ s,
+ ...
+){
+ standardGeneric( "ternaryDataTest" )
+}
+
+rm("ternaryDataTest")
+
+setGeneric(
+ "ternaryDataTest",
+ function(
+ s,
+ ...
+ ){
+ standardGeneric( "ternaryDataTest" )
+ }
+)
+
+# showMethods("ternaryDataTest")
+
+
+
+### Set and check the ternarySystem. Used inside functions.
+ternarySystemSet <- function( s = "default" ){
+ if( is.character( s ) ){
+ s <- ternarySystemGet( s = s )
+ }else if( !is( s, "ternarySystem" ) ){
+ stop( "'s' must be a 'character' or a 'ternarySystem' x" )
+ }
+
+ # validObject( s ) # Create an infinite loop!
+
+ return( s )
+}
+
+
+
+
+#'@rdname ternaryDataTest-methods
+#'@aliases ternaryDataTest,ternarySystem-method
+#'
+#'@export
+#'
+#'@docType methods
+#'
+setMethod(
+ f = "ternaryDataTest",
+ signature = signature(
+ s = "ternarySystem"
+ ),
+ definition = function(
+ s,
+ x,
+ testRange = TRUE,
+ testSum = TRUE,
+ ...
+ ){
+ geo <- s@'ternaryGeometry'
+ var <- s@'ternaryVariables'
+ fracSum <- fracSum( x = s )
+
+ # Tolerance:
+ fracSumTol <- getTpPar( par = "fracSumTol" ) * fracSum
+
+
+ # message( "data.frame, missing, ternaryGeometry, ternaryVariables" )
+
+ # Check the column names:
+ blrNames0 <- var@'blrNames'
+
+ # Test x class
+ if( missing( "x" ) ){ stop( "'x' is missing" ) }
+
+ if( is.matrix( x ) ){
+ x <- as.data.frame( x )
+ }else if( !is.data.frame( x ) ){
+ stop( sprintf(
+ "'x' must be a data.frame or a matrix (now: %s)",
+ paste( class(x), collapse = "; " )
+ ) )
+ }
+
+ testColVert <- blrNames0 %in% colnames( x )
+
+ if( any( !testColVert ) ){
+ stop( sprintf(
+ "Some column missing in 'x' (%s)",
+ paste(
+ colnames( x )[ !testColVert ],
+ collapse = ", "
+ )
+ ) )
+ }
+
+ # Check missing values
+ if( any( is.na( x ) ) ){
+ stop( "Some values in 'x' are missing. Missing values are not allowed" )
+ }
+
+ if( testRange & (nrow( x ) != 0) ){
+ # Check that no fraction is negative
+ if( any( x[, blrNames0 ] < 0 ) ){
+ stop( "Some fractions in 'x' are negative. Fractions can't be negative" )
+ }
+
+ # Check that no fraction is over fracSum
+ if( any( x[, blrNames0 ] > fracSum ) ){
+ stop( sprintf(
+ "Some fractions in 'x' are bigger than the expected sum of fractions (%s)",
+ fracSum
+ ) )
+ }
+ }
+
+ if( testSum & (nrow( x ) != 0) ){
+ # Check the fractions' sum
+ testFracSum <- apply(
+ X = x[, blrNames0 ],
+ MARGIN = 1,
+ FUN = sum
+ )
+
+ # Within accepted bounds?
+ testFracSum <-
+ (testFracSum >= (fracSum - fracSumTol)) &
+ (testFracSum <= (fracSum + fracSumTol))
+
+ if( any( !testFracSum ) ){
+ stop( sprintf(
+ "The fraction sum of some rows in 'x' is bigger than the expected sum of fractions (%s)",
+ fracSum
+ ) )
+ }
+ }
+
+ }
+)
+
+
+#'@rdname ternaryDataTest-methods
+#'@aliases ternaryDataTest,character-method
+#'
+#'@export
+#'
+#'@docType methods
+#'
+setMethod(
+ f = "ternaryDataTest",
+ signature = signature(
+ s = "character"
+ ),
+ definition = function(
+ s,
+ ...
+ ){
+ # Fetch the ternarySystem
+ s <- ternarySystemGet( s = s )
+
+ # Call relevant method:
+ ternaryDataTest( s = s, ... )
+ }
+)
+
+
+#'@rdname ternaryDataTest-methods
+#'@aliases ternaryDataTest,missing-method
+#'
+#'@export
+#'
+#'@docType methods
+#'
+setMethod(
+ f = "ternaryDataTest",
+ signature = signature(
+ s = "missing"
+ ),
+ definition = function(
+ s,
+ ...
+ ){
+ # Fetch the ternarySystem
+ s <- ternarySystemGet()
+
+ # Call relevant method:
+ ternaryDataTest( s = s, ... )
+ }
+)
+
+
+
+
+#'NOT EXPORTED Draw an invisible base-plot for ternaryPlot
+#'
+#'NOT EXPORTED Draw an invisible base-plot for ternaryPlot
+#'
+#'
+#'@param s
+#' A \code{\linkS4class{ternarySystem}} object, or a single
+#' \code{character} string. Can be missing.
+#'
+#'@param x
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/soiltexture -r 96
More information about the Soiltexture-commits
mailing list