From noreply at r-forge.r-project.org Thu Jan 7 10:05:15 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Jan 2016 10:05:15 +0100 (CET) Subject: [Soiltexture-commits] r147 - / pkg/ternaryplot pkg/ternaryplot/R pkg/ternaryplot/inst/examples pkg/ternaryplot/man pkg/ternaryplot/tests prepare Message-ID: <20160107090515.BFE4E187E23@r-forge.r-project.org> Author: jmoeys Date: 2016-01-07 10:05:15 +0100 (Thu, 07 Jan 2016) New Revision: 147 Added: pkg/ternaryplot/R/otherTernaryPlots.R pkg/ternaryplot/R/tableOfContent.R pkg/ternaryplot/man/print.ternaryGeometry.Rd pkg/ternaryplot/man/print.ternarySystem.Rd pkg/ternaryplot/man/print.ternaryVariables.Rd pkg/ternaryplot/man/ternaryAxis-methods.Rd Modified: pkg/ternaryplot/DESCRIPTION pkg/ternaryplot/NAMESPACE pkg/ternaryplot/NEWS 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/ternarygrid.R pkg/ternaryplot/R/ternaryplot.R pkg/ternaryplot/REVISION pkg/ternaryplot/inst/examples/createTernaryGeometry-example.R pkg/ternaryplot/inst/examples/ternaryPlot-example.R pkg/ternaryplot/man/blrClock-methods.Rd pkg/ternaryplot/man/blrLabels-methods.Rd pkg/ternaryplot/man/blrNames-methods.Rd pkg/ternaryplot/man/createTernaryGeometry.Rd pkg/ternaryplot/man/createTernaryGrid-methods.Rd pkg/ternaryplot/man/createTernarySystem.Rd pkg/ternaryplot/man/createTernaryVariables.Rd pkg/ternaryplot/man/deg2rad.Rd pkg/ternaryplot/man/fracSum-methods.Rd pkg/ternaryplot/man/getTernarySystem.Rd pkg/ternaryplot/man/getTpPar.Rd pkg/ternaryplot/man/listTernarySystem.Rd pkg/ternaryplot/man/ternary2SpatialPolygonsDataFrame-methods.Rd pkg/ternaryplot/man/ternary2xy-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/ternaryCheck-methods.Rd pkg/ternaryplot/man/ternaryClockSwitch.Rd pkg/ternaryplot/man/ternaryData-methods.Rd pkg/ternaryplot/man/ternaryGeometry-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/ternaryText-methods.Rd pkg/ternaryplot/man/ternaryTicks-methods.Rd pkg/ternaryplot/man/ternaryVariables-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 prepare/ternaryplotSource.R ternaryplot_Document.R Log: Modified: pkg/ternaryplot/DESCRIPTION =================================================================== --- pkg/ternaryplot/DESCRIPTION 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/DESCRIPTION 2016-01-07 09:05:15 UTC (rev 147) @@ -1,10 +1,11 @@ Package: ternaryplot -Version: 0.3.0 -Date: 2014-03-28 -Title: Ternary plots and ternary classifications. +Version: 0.3.1 +Date: 2016-01-07 +Title: Infrastructure for ternary plots and ternary classifications (S3-classes) Author: Julien MOEYS Maintainer: Julien MOEYS -Description: Ternary plots and ternary classifications. +Description: Infrastructure for ternary plots and ternary classifications (S3-classes) License: AGPL-3 URL: http://www.slu.se/ckb -Depends: R (>= 3.0.2), sp, MASS +Depends: R (>= 3.2.0) +Imports: sp Modified: pkg/ternaryplot/NAMESPACE =================================================================== --- pkg/ternaryplot/NAMESPACE 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/NAMESPACE 2016-01-07 09:05:15 UTC (rev 147) @@ -1,44 +1,5 @@ -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(blrClock) -export(blrLabels) -export(blrNames) -export(createTernaryGeometry) -export(createTernaryGrid) -export(createTernarySystem) -export(createTernaryVariables) -export(deg2rad) -export(fracSum) -export(getTernarySystem) -export(getTpPar) -export(listTernarySystem) -export(ternary2SpatialPolygonsDataFrame) -export(ternary2xy) -export(ternaryArrows) -export(ternaryBox) -export(ternaryCheck) -export(ternaryData) -export(ternaryGeometry) -export(ternaryGrid) -export(ternaryPlot) -export(ternaryPoints) -export(ternarySegments) -export(ternaryText) -export(ternaryVariables) -export(ternaryWindow) -export(tlrAngles) -export(tpPar) +# Generated by roxygen2 (4.1.1): do not edit by hand + S3method("blrClock<-",ternaryGeometry) S3method("blrClock<-",ternarySystem) S3method("blrLabels<-",ternarySystem) @@ -67,11 +28,16 @@ S3method(createTernaryGrid,ternarySystem) S3method(fracSum,ternaryGeometry) S3method(fracSum,ternarySystem) +S3method(print,ternaryGeometry) +S3method(print,ternarySystem) +S3method(print,ternaryVariables) S3method(ternary2SpatialPolygonsDataFrame,ternaryPolygons) S3method(ternary2xy,character) S3method(ternary2xy,ternaryData) S3method(ternary2xy,ternarySystem) S3method(ternaryArrows,ternarySystem) +S3method(ternaryAxis,character) +S3method(ternaryAxis,ternarySystem) S3method(ternaryBox,ternarySystem) S3method(ternaryCheck,ternaryGeometry) S3method(ternaryCheck,ternarySystem) @@ -90,3 +56,54 @@ S3method(ternaryWindow,ternarySystem) S3method(tlrAngles,ternaryGeometry) S3method(tlrAngles,ternarySystem) +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(blrClock) +export(blrLabels) +export(blrNames) +export(createTernaryGeometry) +export(createTernaryGrid) +export(createTernarySystem) +export(createTernaryVariables) +export(deg2rad) +export(fracSum) +export(getTernarySystem) +export(getTpPar) +export(listTernarySystem) +export(ternary2SpatialPolygonsDataFrame) +export(ternary2xy) +export(ternaryArrows) +export(ternaryAxis) +export(ternaryBox) +export(ternaryCheck) +export(ternaryData) +export(ternaryGeometry) +export(ternaryGrid) +export(ternaryPlot) +export(ternaryPoints) +export(ternarySegments) +export(ternaryText) +export(ternaryVariables) +export(ternaryWindow) +export(tlrAngles) +export(tpPar) +importFrom(sp,Line) +importFrom(sp,Lines) +importFrom(sp,Polygon) +importFrom(sp,Polygons) +importFrom(sp,SpatialLines) +importFrom(sp,SpatialPoints) +importFrom(sp,SpatialPolygons) +importFrom(sp,SpatialPolygonsDataFrame) +importFrom(sp,rbind.SpatialLines) Modified: pkg/ternaryplot/NEWS =================================================================== --- pkg/ternaryplot/NEWS 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/NEWS 2016-01-07 09:05:15 UTC (rev 147) @@ -1,6 +1,13 @@ package: ternaryplot +CHANGES IN VERSION 0.3.1 + + 2016/01/07 Further development. Create a 2nd class in + addition to ternaryGeometry for creating + geometry-specific methods (instead of complicated + case specific code). + CHANGES IN VERSION 0.3.0 2014/03/28 Package converted from S4-classes to S3-classes Modified: pkg/ternaryplot/R/aa01-ternaryplot-options.R =================================================================== --- pkg/ternaryplot/R/aa01-ternaryplot-options.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa01-ternaryplot-options.R 2016-01-07 09:05:15 UTC (rev 147) @@ -62,6 +62,8 @@ .tpParList[[ "sp" ]] <- TRUE +.tpParList[[ "onFailure" ]] <- stop + # GRAPHICAL PARAMETERS # ==================== @@ -75,9 +77,10 @@ .tpParList[[ "ticksAt" ]] <- seq( from = 0, to = 1, by = .1 ) -.tpParList[[ "ticksShift" ]] <- 0.025 +.tpParList[[ "ticksShift" ]] <- NA_real_ # 0.040 -.tpParList[[ "arrowsShift" ]] <- c( 0.075, 0.125 ) +.tpParList[[ "arrowsShift" ]] <- rep( NA_real_, 2 ) # c( 0.075, 0.125 ) +.tpParList[[ "arrowsHeight" ]] <- 0.75 .tpParList[[ "arrowsCoords" ]] <- c( .15, .45, .45, .55 ) @@ -159,12 +162,25 @@ #'@param ticksShift #' Single numeric. Tick-marks 'size', expressed so that #' \code{ticksShift * fracSum} is the length of the tick-marks. +#' If \code{NA}, it is calculated internally from +#' \code{par("tcl")} and the height in of a margin line +#' in inches, estimated using the internal function +#' \code{.nbMargin2diffXY()}. #' #'@param arrowsShift -#' Vector of tow numeric values. Axis' arrows' shift from their +#' Vector of two numeric values. Axis' arrows' shift from their #' axis, expressed so that \code{arrowsShift * fracSum} is the -#' start and end point. +#' start and end point. If \code{NA}, the arrow shift from +#' their axis will be calculated from \code{par("mgp")[ 1L ]} +#' and \code{arrowsHeight} (below). #' +#'@param arrowsHeight +#' Single numeric values. Axis' arrows' height (distance +#' between the 1st part of the arrow and the 2nd part of the +#' arrow), expressed in fraction of margin-lines-height +#' (same as \code{par("mgp")}). Only used when \code{arrowsShift} +#' (above) is \code{NA}. +#' #'@param vertices #' Vertices of a ternary classification (default): a #' \code{\link[base]{data.frame}} with 4 columns \code{id}, @@ -203,6 +219,13 @@ #' \code{\link[base]{data.frame}} with the x-y coordinates of the #' graphical element. #' +#'@param onFailure +#' R \code{\link{function}}. Function that should be used by +#' \code{\link[ternaryplot]{ternaryCheck}} (and related methods) +# when a non-conformity is found. Default value is \code{\link{stop}}, +# but can be changed to \code{\link{warning}} or even +# \code{\link{message}} (at the user's own risk). +#' #'@param grid.line.col #' Single character value representing a color. Color of the #' grid-lines added to a ternary plot. @@ -244,16 +267,17 @@ scale, okClock, sp, + onFailure, ticksAt, ticksShift, arrowsShift, + arrowsHeight, arrowsCoords, arrowsBreak, grid.line.col, axis.line.lwd, - plot.bg - + plot.bg ){ parList <- names( formals(tpPar) ) parList <- parList[ !(parList %in% c( "par", "reset" )) ] Modified: pkg/ternaryplot/R/aa02-ternaryplot-classes.R =================================================================== --- pkg/ternaryplot/R/aa02-ternaryplot-classes.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa02-ternaryplot-classes.R 2016-01-07 09:05:15 UTC (rev 147) @@ -15,14 +15,13 @@ #'Check the validity of ternary*-class objects #' #' +#'@seealso Arguments \code{onFailure} and \code{okClock} in +#' \code{\link[ternaryplot]{getTpPar}} (package options). +#' +#' #'@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. #' @@ -43,14 +42,18 @@ #'@rdname ternaryCheck-methods #' #'@method ternaryCheck ternaryGeometry -#'@S3method ternaryCheck ternaryGeometry +#' +#'@export +#' ternaryCheck.ternaryGeometry <- function( x, - onFailure=stop, + # onFailure=stop, ... ){ valid <- TRUE + onFailure <- getTpPar( "onFailure" ) + # Check names: nm <- c( "tlrAngles", "blrClock", "fracSum" ) testNames <- nm %in% names( x ) @@ -138,14 +141,18 @@ #'@rdname ternaryCheck-methods #' #'@method ternaryCheck ternaryVariables -#'@S3method ternaryCheck ternaryVariables +#' +#'@export +#' ternaryCheck.ternaryVariables <- function( x, - onFailure=stop, + # onFailure=stop, ... ){ valid <- TRUE + onFailure <- getTpPar( "onFailure" ) + # Check names: nm <- c( "blrNames", "blrLabels" ) testNames <- nm %in% names( x ) @@ -200,14 +207,18 @@ #'@rdname ternaryCheck-methods #' #'@method ternaryCheck ternarySystem -#'@S3method ternaryCheck ternarySystem +#' +#'@export +#' ternaryCheck.ternarySystem <- function( x, - onFailure=stop, + # onFailure=stop, ... ){ valid <- TRUE + onFailure <- getTpPar( "onFailure" ) + # Check names: nm <- c( "ternaryGeometry", "ternaryVariables", "main", "vertices", "classes", "scale" ) @@ -343,6 +354,38 @@ # createTernaryGeometry ============================================ +## # Function that generates the class of ternaryGeometry object +## # (mostly the 2nd class) after the blrClock-argument. +.generateTernaryGeometryClass <- function( + blrClock +){ + if( !"logical" %in% ( blrClock ) ){ + sprintf( + "'blrClock' is not a logical (but: %s).", + paste( class( blrClock ), collapse = "; " ) + ) + } + + if( all( blrClock ) ){ + class2 <- "geo_TTT" + + }else if( all( !blrClock ) ){ + class2 <- "geo_FFF" + + }else if( all( blrClock == c( FALSE, TRUE, NA ) ) ){ + class2 <- "geo_FTX" + + }else if( all( blrClock == c( TRUE, NA, FALSE ) ) ){ + class2 <- "geo_TXF" + + }else{ + class2 <- character(0) + + } + + return( c( "ternaryGeometry", class2 ) ) +} + #'Creates a ternaryGeometry object: ternary plot geometry definition. #' #'Creates a ternaryGeometry object: ternary plot geometry definition. @@ -358,18 +401,25 @@ #' of the ternary diagram. Must sum to 180 degrees. #' #'@param blrClock -#' Vector of logical. Bottom, left and right axis directions. +#' Vector of logical value. 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 +#' Single numeric value. 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}} #' #' +#'@return +#' Return a list of \code{ternaryGeometry}-class (S3). A 2nd class is added +#' that depends on \code{blrClock}, and is formed after the pattern +#' \code{"geo_[blrClockCode]"}, where \code{[blrClockCode]} can be +#' \code{"TTT"}, \code{"FFF"}, \code{"FTX"} or \code{"TXF"}. +#' +#' #'@example inst/examples/createTernaryGeometry-example.R #' #' @@ -380,7 +430,7 @@ createTernaryGeometry <- function( tlrAngles = c( 60, 60, 60 ), blrClock = rep( TRUE, 3 ), - fracSum = 100, + fracSum = 100, ... ){ # Create a ternary geometry object: @@ -390,12 +440,15 @@ "fracSum" = fracSum ) + # Set the class - class( tg ) <- "ternaryGeometry" + class( tg ) <- .generateTernaryGeometryClass( + blrClock = tg[[ "blrClock" ]] ) # Check: ternaryCheck( tg, ... ) + return( tg ) Modified: pkg/ternaryplot/R/aa03-ternaryplot-classes-utility.R =================================================================== --- pkg/ternaryplot/R/aa03-ternaryplot-classes-utility.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa03-ternaryplot-classes-utility.R 2016-01-07 09:05:15 UTC (rev 147) @@ -44,7 +44,9 @@ #'@rdname blrNames-methods #' #'@method blrNames ternarySystem -#'@S3method blrNames ternarySystem +#' +#'@export +#' blrNames.ternarySystem <- function( s, ... ){ return( s[[ 'ternaryVariables']][[ 'blrNames' ]] ) } @@ -54,7 +56,9 @@ #'@rdname blrNames-methods #' #'@method blrNames ternaryVariables -#'@S3method blrNames ternaryVariables +#' +#'@export +#' blrNames.ternaryVariables <- function( s, ... ){ return( s[[ 'blrNames' ]] ) } @@ -82,8 +86,9 @@ #'@rdname blrNames-methods #' #'@method blrNames<- ternarySystem -#'@S3method blrNames<- ternarySystem #' +#'@export +#' #'@usage \method{blrNames}{ternarySystem}(s, ...) <- value #' `blrNames<-.ternarySystem` <- function( @@ -113,8 +118,10 @@ #'@rdname blrNames-methods #' #'@method blrNames<- ternaryVariables -#'@S3method blrNames<- ternaryVariables #' +#'@export +#' +#' #'@usage \method{blrNames}{ternaryVariables}(s, ...) <- value #' `blrNames<-.ternaryVariables` <- function( @@ -167,7 +174,9 @@ #'@rdname blrLabels-methods #' #'@method blrLabels ternarySystem -#'@S3method blrLabels ternarySystem +#' +#'@export +#' blrLabels.ternarySystem <- function( s, ... ){ return( s[[ 'ternaryVariables']][[ 'blrLabels' ]] ) } @@ -177,7 +186,9 @@ #'@rdname blrLabels-methods #' #'@method blrLabels ternaryVariables -#'@S3method blrLabels ternaryVariables +#' +#'@export +#' blrLabels.ternaryVariables <- function( s, ... ){ return( s[[ 'blrLabels' ]] ) } @@ -205,8 +216,10 @@ #'@rdname blrLabels-methods #' #'@method blrLabels<- ternarySystem -#'@S3method blrLabels<- ternarySystem #' +#'@export +#' +#' #'@usage \method{blrLabels}{ternarySystem}(s, ...) <- value #' `blrLabels<-.ternarySystem` <- function( @@ -226,8 +239,10 @@ #'@rdname blrLabels-methods #' #'@method blrLabels<- ternaryVariables -#'@S3method blrLabels<- ternaryVariables #' +#'@export +#' +#' #'@usage \method{blrLabels}{ternaryVariables}(s, ...) <- value #' `blrLabels<-.ternaryVariables` <- function( @@ -283,7 +298,9 @@ #'@rdname blrClock-methods #' #'@method blrClock ternarySystem -#'@S3method blrClock ternarySystem +#' +#'@export +#' blrClock.ternarySystem <- function( s, ... @@ -296,7 +313,9 @@ #'@rdname blrClock-methods #' #'@method blrClock ternaryGeometry -#'@S3method blrClock ternaryGeometry +#' +#'@export +#' blrClock.ternaryGeometry <- function( s, ... @@ -327,8 +346,10 @@ #'@rdname blrClock-methods #' #'@method blrClock<- ternarySystem -#'@S3method blrClock<- ternarySystem #' +#'@export +#' +#' #'@usage \method{blrClock}{ternarySystem}(s, ...) <- value #' `blrClock<-.ternarySystem` <- function( @@ -338,7 +359,15 @@ ){ s[[ 'ternaryGeometry' ]][[ 'blrClock' ]] <- value + + # Set the class (in case it has changed) + class( s[[ 'ternaryGeometry' ]] ) <- .generateTernaryGeometryClass( + blrClock = s[[ "blrClock" ]] ) + + + # Check the validity ternaryCheck( s[[ 'ternaryGeometry' ]], ... ) + return( s ) } @@ -348,8 +377,10 @@ #'@rdname blrClock-methods #' #'@method blrClock<- ternaryGeometry -#'@S3method blrClock<- ternaryGeometry #' +#'@export +#' +#' #'@usage \method{blrClock}{ternaryGeometry}(s, ...) <- value #' `blrClock<-.ternaryGeometry` <- function( @@ -359,6 +390,12 @@ ){ s[[ 'blrClock' ]] <- value + + # Set the class (in case it has changed) + class( s ) <- .generateTernaryGeometryClass( + blrClock = s[[ "blrClock" ]] ) + + ternaryCheck( s, ... ) return( s ) @@ -399,13 +436,15 @@ ){ UseMethod( "fracSum" ) } - + #'@rdname fracSum-methods #' #'@method fracSum ternarySystem -#'@S3method fracSum ternarySystem +#' +#'@export +#' fracSum.ternarySystem <- function( s, ... @@ -418,7 +457,9 @@ #'@rdname fracSum-methods #' #'@method fracSum ternaryGeometry -#'@S3method fracSum ternaryGeometry +#' +#'@export +#' fracSum.ternaryGeometry <- function( s, ... @@ -449,8 +490,10 @@ #'@rdname fracSum-methods #' #'@method fracSum<- ternarySystem -#'@S3method fracSum<- ternarySystem #' +#'@export +#' +#' #'@usage \method{fracSum}{ternarySystem}(s, ...) <- value #' `fracSum<-.ternarySystem` <- function( @@ -470,8 +513,10 @@ #'@rdname fracSum-methods #' #'@method fracSum<- ternaryGeometry -#'@S3method fracSum<- ternaryGeometry #' +#'@export +#' +#' #'@usage \method{fracSum}{ternaryGeometry}(s, ...) <- value #' `fracSum<-.ternaryGeometry` <- function( @@ -527,7 +572,9 @@ #'@rdname tlrAngles-methods #' #'@method tlrAngles ternarySystem -#'@S3method tlrAngles ternarySystem +#' +#'@export +#' tlrAngles.ternarySystem <- function( s, ... @@ -540,7 +587,9 @@ #'@rdname tlrAngles-methods #' #'@method tlrAngles ternaryGeometry -#'@S3method tlrAngles ternaryGeometry +#' +#'@export +#' tlrAngles.ternaryGeometry <- function( s, ... @@ -571,8 +620,10 @@ #'@rdname tlrAngles-methods #' #'@method tlrAngles<- ternarySystem -#'@S3method tlrAngles<- ternarySystem #' +#'@export +#' +#' #'@usage \method{tlrAngles}{ternarySystem}(s, ...) <- value #' `tlrAngles<-.ternarySystem` <- function( @@ -592,8 +643,10 @@ #'@rdname tlrAngles-methods #' #'@method tlrAngles<- ternaryGeometry -#'@S3method tlrAngles<- ternaryGeometry #' +#'@export +#' +#' #'@usage \method{tlrAngles}{ternaryGeometry}(s, ...) <- value #' `tlrAngles<-.ternaryGeometry` <- function( @@ -645,7 +698,9 @@ #'@rdname ternaryGeometry-methods #' #'@method ternaryGeometry ternarySystem -#'@S3method ternaryGeometry ternarySystem +#' +#'@export +#' ternaryGeometry.ternarySystem <- function( s, ... @@ -676,8 +731,10 @@ #'@rdname ternaryGeometry-methods #' #'@method ternaryGeometry<- ternarySystem -#'@S3method ternaryGeometry<- ternarySystem #' +#'@export +#' +#' #'@usage \method{ternaryGeometry}{ternarySystem}( s, ... ) <- value #' `ternaryGeometry<-.ternarySystem` <- function( @@ -694,6 +751,82 @@ +# print.ternaryGeometry ========================================= + +#'Print the content of a ternaryGeometry object in a human readable format. +#' +#'Print the content of a \code{ternaryGeometry} object +#' (S3-class) in a human readable format. +#' +#' +#'@param x +#' A \code{ternaryGeometry} object, as created with +#' \code{\link[ternaryplot]{createTernaryGeometry}}. +#' +#'@param prefix +#' Single character string. Prefix used before the different +#' items in \code{x} (intended for internal use, for example +#' \code{prefix = "$ternaryGeometry"}). +#' +#'@param collapse +#' Single character string. Passed to +#' \code{\link{paste}( ..., collapse )} when displaying the +#' items' values. +#' +#'@param \dots +#' Additional parameters passed to specific methods (not +#' used). +#' +#' +#'@method print ternaryGeometry +#' +#'@export +#' +print.ternaryGeometry <- function( + x, + prefix = "", + collapse = "; ", + ... +){ + cat( "A ternaryGeometry (S3-class) object:\n\n" ) + + cat( sprintf( + "%s$tlrAngles: %s\n", + prefix, + paste( as.character( x[[ "tlrAngles" ]] ), collapse = collapse ) + ) ) + + cat( " Angles of the top, left and right vertices [degrees]\n" ) + cat( " Get or set with tlrAngles() or tlrAngles() <- value\n\n" ) + + clock <- as.character( x[[ "blrClock" ]] ) + clock[ is.na( clock ) ] <- "NA" + + cat( sprintf( + "%s$blrClock: %s\n", + prefix, + paste( clock, collapse = collapse ) + ) ) + + cat( " Directions of the bottom, left and right axis (edges)\n" ) + cat( " TRUE is clockwise (CW), FALSE is counter-CW and NA is centripetal\n" ) + cat( " Get or set with blrClock() or blrClock() <- value\n\n" ) + + cat( sprintf( + "%s$fracSum: %s\n", + prefix, + x[[ "fracSum" ]] + ) ) + + cat( " Sum of the 3 variables in the diagram\n" ) + cat( " 1 for fractions, 100 for percentages\n" ) + cat( " Get or set with fracSum() or fracSum() <- value\n\n" ) + + return( invisible( x ) ) +} + + + # ternaryVariables ============================================== #'Set or get the ternaryVariables of a ternarySystem object. @@ -729,7 +862,9 @@ #'@rdname ternaryVariables-methods #' #'@method ternaryVariables ternarySystem -#'@S3method ternaryVariables ternarySystem +#' +#'@export +#' ternaryVariables.ternarySystem <- function( s, ... @@ -760,8 +895,10 @@ #'@rdname ternaryVariables-methods #' #'@method ternaryVariables<- ternarySystem -#'@S3method ternaryVariables<- ternarySystem #' +#'@export +#' +#' #'@usage \method{ternaryVariables}{ternarySystem}( s, ... ) <- value #' `ternaryVariables<-.ternarySystem` <- function( @@ -776,3 +913,150 @@ return( s ) } + + +# print.ternaryVariables ========================================= + +#'Print the content of a ternaryVariables object in a human readable format. +#' +#'Print the content of a \code{ternaryVariables} object +#' (S3-class) in a human readable format. +#' +#' +#'@param x +#' A \code{ternaryVariables} object, as created with +#' \code{\link[ternaryplot]{createTernaryVariables}}. +#' +#'@param prefix +#' Single character string. Prefix used before the different +#' items in \code{x} (intended for internal use, for example +#' \code{prefix = "$ternaryGeometry"}). +#' +#'@param collapse +#' Single character string. Passed to +#' \code{\link{paste}( ..., collapse )} when displaying the +#' items' values. +#' +#'@param \dots +#' Additional parameters passed to specific methods (not +#' used). +#' +#'@export +#' +#'@method print ternaryVariables +#' +print.ternaryVariables <- function( + x, + prefix = "", + collapse = "; ", + ... +){ + cat( "A ternaryVariables (S3-class) object:\n\n" ) + + cat( sprintf( + "%s$blrNames: %s\n", + prefix, + paste( x[[ "blrNames" ]], collapse = collapse ) + ) ) + + cat( " Names of the bottom, left and right variables\n" ) + cat( " Get or set with blrNames() and blrNames() <- value\n\n" ) + + cat( sprintf( + "%s$blrLabels: %s\n", + prefix, + paste( x[[ "blrLabels" ]], collapse = collapse ) + ) ) + + cat( " Labels of the bottom, left and right axis\n" ) + cat( " Get or set with blrLabels() and blrLabels() <- value\n\n" ) + + return( invisible( x ) ) +} + + + +# print.ternarySystem ====================================== + +#'Print the content of a ternarySystem object in a human readable format. +#' +#'Print the content of a \code{ternarySystem} object +#' (S3-class) in a human readable format. +#' +#' +#'@param x +#' A \code{ternarySystem} object, as created with +#' \code{\link[ternaryplot]{createTernarySystem}}. +#' +#'@param prefix +#' Single character string. Prefix used before the different +#' items in \code{x} (intended for internal use, for example +#' \code{prefix = "$ternaryGeometry"}). +#' +#'@param collapse +#' Single character string. Passed to +#' \code{\link{paste}( ..., collapse )} when displaying the +#' items' values. +#' +#'@param \dots +#' Additional parameters passed to specific methods (not +#' used). +#' +#'@export +#' +#'@method print ternarySystem +#' +print.ternarySystem <- function( + x, + prefix = "", + collapse = "; ", + ... +){ + cat( "A ternarySystem (S3-class) object:\n\n" ) + + cat( "$ternaryVariables\n" ) + + print( + x = x[[ "ternaryVariables" ]], + prefix = paste0( prefix, "$ternaryVariables" ), + collapse = collapse, + ... + ) + + cat( "$ternaryGeometry\n" ) + + print( + x = x[[ "ternaryGeometry" ]], + prefix = paste0( prefix, "$ternaryGeometry" ), + collapse = collapse, + ... + ) + + cat( sprintf( "%s$main: %s\n", prefix, x[[ "main" ]] ) ) + cat( " Default title of the ternary diagram\n\n" ) + + cat( sprintf( "%s$vertices:\n", prefix ) ) + print( x[[ "vertices" ]] ) + cat( " A data.frame containing the vertices identifiers and positions\n" ) + cat( " Empty for a ternary-system with no classes\n" ) + cat( " Can not be altered independently from $classes\n" ) + cat( " Use createTernarySystem() to modify them\n\n" ) + + cat( sprintf( "%s$classes:\n", prefix ) ) + print( x[[ "classes" ]] ) + cat( " A data.frame containing the classes' abbreviations,\n" ) + cat( " names and lists of vertices\n" ) + cat( " Empty for a ternary-system with no classes\n" ) + cat( " Can not be altered independently from $vertices\n" ) + cat( " Use createTernarySystem() to modify them\n\n" ) + + cat( sprintf( "%s$scale:\n", prefix ) ) + print( x[[ "scale" ]] ) + cat( " A data.frame containing the min and max limits (rows)\n" ) + cat( " of each axis (columns)\n" ) + cat( " Currently not used (zoom feature not implemented)\n\n" ) + + return( invisible( x ) ) +} + + Modified: pkg/ternaryplot/R/aa04-ternarysystems.R =================================================================== --- pkg/ternaryplot/R/aa04-ternarysystems.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa04-ternarysystems.R 2016-01-07 09:05:15 UTC (rev 147) @@ -22,19 +22,15 @@ # Dummy ternary classification: ternarySystemEnv[[ "dummy" ]] <- createTernarySystem( - - "ternaryGeometry" = createTernaryGeometry(), - - "main" = "Ternary plot (dummy)", - - "vertices" = data.frame( + "ternaryGeometry" = createTernaryGeometry(), + "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( + "classes" = data.frame( "abbrev" = c( "C1", "C2" ), @@ -47,8 +43,7 @@ ) ), stringsAsFactors = FALSE ), - - "scale" = NULL + "scale" = NULL ) Modified: pkg/ternaryplot/R/aa05-ternarydata.R =================================================================== --- pkg/ternaryplot/R/aa05-ternarydata.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa05-ternarydata.R 2016-01-07 09:05:15 UTC (rev 147) @@ -79,7 +79,9 @@ #'@rdname ternaryData-methods #' #'@method ternaryData character -#'@S3method ternaryData character +#' +#'@export +#' ternaryData.character <- function( s, ... @@ -94,7 +96,9 @@ #'@rdname ternaryData-methods #' #'@method ternaryData ternarySystem -#'@S3method ternaryData ternarySystem +#' +#'@export +#' ternaryData.ternarySystem <- function( s, x, Modified: pkg/ternaryplot/R/aa06-ternary2xy.R =================================================================== --- pkg/ternaryplot/R/aa06-ternary2xy.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa06-ternary2xy.R 2016-01-07 09:05:15 UTC (rev 147) @@ -75,7 +75,9 @@ #'@rdname ternary2xy-methods #' #'@method ternary2xy character -#'@S3method ternary2xy character +#' +#'@export +#' ternary2xy.character <- function( s, ... @@ -94,7 +96,9 @@ #'@rdname ternary2xy-methods #' #'@method ternary2xy ternaryData -#'@S3method ternary2xy ternaryData +#' +#'@export +#' ternary2xy.ternaryData <- function( s, ... @@ -112,7 +116,9 @@ #'@rdname ternary2xy-methods #' #'@method ternary2xy ternarySystem -#'@S3method ternary2xy ternarySystem +#' +#'@export +#' ternary2xy.ternarySystem <- function( s, x, Modified: pkg/ternaryplot/R/aa07-plotUtilities.R =================================================================== --- pkg/ternaryplot/R/aa07-plotUtilities.R 2015-05-15 12:02:10 UTC (rev 146) +++ pkg/ternaryplot/R/aa07-plotUtilities.R 2016-01-07 09:05:15 UTC (rev 147) @@ -6,165 +6,9 @@ # | License: AGPL3, Affero General Public License version 3 | # +-------------------------------------------------------------+ +# grconvertX +# http://stackoverflow.com/questions/29125019/get-margin-line-locations-mgp-in-user-coordinates - -# .transfMgpTo0_1 =============================================== - -## #INTERNAL: Transform margin lines, as in par('mgp'), into margin's relative coordinates (0 to 1) -## # -## #INTERNAL: Transform margin lines, as in par('mgp'), into margin's relative coordinates (0 to 1) -## # -## # -## #@param z -## # A vector of numerical values. z-position, in number of lines within the margin -## # -## #@param side -## # Single integer value. Margin's id 1=below, 2=left, 3=above and 4=right -## # -## #@param mar -## # A vector of 4 numerical values, giving the margin's size -## # in number of lines (bottom, left, top, right). If \code{NULL}, -## # \code{\link[graphics]{par}('mar')} is used. -## # -.transfMgpTo0_1 <- function( - z = par( 'mgp' )[ 2 ], - side = 1L, # 1=below, 2=left, 3=above and 4=right - mar = par( 'mar' ) # c(bottom, left, top, right) -){ - # Return the relative position - return( z / mar[ side ] ) -} - - - -# .transf0_1ToPlt =============================================== - -## #INTERNAL: Transform margin's relative coordinates (0 to 1) into figure relative coordinates (0 to 1 too) -## # -## #INTERNAL: Transform margin's relative coordinates (0 to 1) into figure relative coordinates (0 to 1 too) -## # -## # -## #@param z -## # A vector of numerical values. z-position, in margin's relative coordinates -## # -## #@param side -## # Single integer value. Margin's id 1=below, 2=left, 3=above and 4=right -## # -## #@param plt -## # A vector of 4 numerical values, giving the coordinates of -## # the plot region as fractions of the current figure region. -## # c(x1, x2, y1, y2). -## # -.transf0_1ToPlt <- function( - z = .5, - side = 1L, # 1=below, 2=left, 3=above and 4=right - plt = par( 'plt' ) # c(x1, x2, y1, y2) -){ - if( side == 1 ){ # below - out <- plt[ 3 ] - z * plt[ 3 ] - - }else if( side == 3 ){ # above - out <- plt[ 4 ] + z * (1 - plt[ 4 ]) - - }else if( side == 2 ){ # left - out <- plt[ 1 ] - z * plt[ 1 ] - - }else{ # right - out <- plt[ 2 ] + z * (1 - plt[ 2 ]) - - } - - return( out ) -} - - - -# .transfPltToXY ================================================ - -## #INTERNAL: Transform plot figures relative coordinates (0 to 1) into plot-region X-Y coordinates -## # -## #INTERNAL: Transform plot figures relative coordinates (0 to 1) into plot-region X-Y coordinates -## # -## # -## #@param z -## # A vector of numerical values. z-position, in margin's relative coordinates -## # -## #@param side -## # Single integer value. Margin's id 1=below, 2=left, 3=above and 4=right -## # -## #@param plt -## # A vector of 4 numerical values, giving the coordinates of -## # the plot region as fractions of the current figure region. -## # c(x1, x2, y1, y2). -## # -## #@param usr -## # A vector of 4 numerical values, giving the extremes of the -## # user coordinates of the plotting region, c(x1, x2, y1, y2). -## # -.transfPltToXY <- function( - z = par( 'plt' )[ 1 ], - side = 1L, # 1=below, 2=left, 3=above and 4=right - plt = par( 'plt' ), # c(x1, x2, y1, y2) - usr = par( 'usr' ) # c(x1, x2, y1, y2) -){ - if( side %in% c( 1, 3 ) ){ # below or above - slope <- diff( usr[ 3:4 ] ) / diff( plt[ 3:4 ] ) - int <- usr[ 3 ] - slope * plt[ 3 ] - - }else{ # side %in% c( 2, 4 ) - slope <- diff( usr[ 1:2 ] ) / diff( plt[ 1:2 ] ) - int <- usr[ 1 ] - slope * plt[ 1 ] - - } - - # conv <- ( par("mai") / par("mar") )[1] / par("cin")[2] - - return( ( z * slope + int ) / 1 ) -} - - - -# .transfMgpToXY ================================================ - -## #INTERNAL: Transform margin lines, as in par('mgp'), into plot-region X-Y coordinates -## # -## #INTERNAL: Transform margin lines, as in par('mgp'), into plot-region X-Y coordinates -## # -## # -## #@param z -## # A vector of numerical values. z-position, in number of lines within the margin -## # -## #@param side -## # Single integer value. Margin's id 1=below, 2=left, 3=above and 4=right -## # -## #@param mar -## # A vector of 4 numerical values, giving the margin's size -## # in number of lines (bottom, left, top, right). If \code{NULL}, -## # \code{\link[graphics]{par}('mar')} is used. -## # -## #@param plt -## # A vector of 4 numerical values, giving the coordinates of -## # the plot region as fractions of the current figure region. -## # c(x1, x2, y1, y2). -## # [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/soiltexture -r 147 From noreply at r-forge.r-project.org Thu Jan 7 10:05:47 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 7 Jan 2016 10:05:47 +0100 (CET) Subject: [Soiltexture-commits] r148 - pkg/ternaryplot/tests Message-ID: <20160107090547.7792E187E23@r-forge.r-project.org> Author: jmoeys Date: 2016-01-07 10:05:47 +0100 (Thu, 07 Jan 2016) New Revision: 148 Removed: pkg/ternaryplot/tests/baseTests.R Log: Deleted: pkg/ternaryplot/tests/baseTests.R =================================================================== --- pkg/ternaryplot/tests/baseTests.R 2016-01-07 09:05:15 UTC (rev 147) +++ pkg/ternaryplot/tests/baseTests.R 2016-01-07 09:05:47 UTC (rev 148) @@ -1,107 +0,0 @@ - - if( Sys.info()[["sysname"]] == "Linux" ){ - setwd( "/home/jules/Dropbox/_WORK/_PROJECTS/r_packages/ternaryplot" ) - }else{ - setwd( "C:/Users/julienm/Dropbox/_WORK/_PROJECTS/r_packages/ternaryplot" ) - } - - source( "R/aa00-ternaryplot-package.R" ) - source( "R/aa01-ternaryplot-options.R" ) - source( "R/aa02-ternaryplot-classes.R" ) - source( "R/aa03-ternaryplot-classes-utility.R" ) - source( "R/aa04-ternarysystems.R" ) - source( "R/aa05-ternarydata.R" ) - source( "R/aa06-ternary2xy.R" ) - source( "R/aa07-plotUtilities.R" ) - source( "R/ternarygrid.R" ) - source( "R/ternaryplot.R" ) - -# library( "ternaryplot" ) -library( "sp" ) - -p <- list( - list( - "blrClock" = rep( T, 3 ), - "tlrAngles" = rep( 60, 3 ) - ), - list( - "blrClock" = rep( F, 3 ), - "tlrAngles" = rep( 60, 3 ) - ), - list( - "blrClock" = c( F, T, NA ), - "tlrAngles" = c(45,90,45) - ), - list( - "blrClock" = c( T, NA, F ), - "tlrAngles" = c(45,45,90) - ) -) - -par( mfrow = c(2,2) ) - - -for( i in 1:length( p ) ){ - s <- getTernarySystem() - - blrClock( s ) <- p[[ i ]][[ "blrClock" ]] - - tlrAngles( s ) <- p[[ i ]][[ "tlrAngles" ]] - - ternaryPlot( s = s ) -} -# Problem: find "## axis orientation is NA" in ternaryplot.R - -par( mfrow = c(1,2), xaxs = "i", yaxs = "i" ) -plot( x = 1, y = 1, asp = TRUE ) -ternaryPlot( s = getTernarySystem() ) -box( col = "red", lty = 2 ) - - - -# Run some tests -s <- ternaryWindow() # Opens a plot window - -# or - -s <- ternaryWindow( "default" ) - -# or - -s <- getTernarySystem() -# tlrAngles(s) <- c(45,90,45) - -s <- ternaryWindow( s = s ) -# .ternaryGridBase( s = s ) - -.ternaryTicks( s = s ) -ternaryGrid( s = s ) -ternaryBox( s = s ) - -blrClock( s ) <- rep( F, 3 ) - -# s@'ternaryGeometry'@'tlrAngles' <- c(45,90,45) - -s <- ternaryWindow( s = s ) -# .ternaryGridBase( s = s ) -.ternaryTicks( s = s ) -ternaryGrid( s = s ) -ternaryBox( s = s ) - -blrClock( s ) <- c( F, T, NA ) -tlrAngles( s ) <- c(45,90,45) - -s <- ternaryWindow( s = s ) -.ternaryTicks( s = s ) -ternaryGrid( s = s ) -ternaryBox( s = s ) - - -blrClock( s ) <- c( T, NA, F ) -tlrAngles( s ) <- c(45,45,90) -s <- ternaryWindow( s = s ) -.ternaryTicks( s = s ) -ternaryGrid( s = s ) -ternaryBox( s = s ) - -