Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc:[1305] trunk/gdata

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 1305
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1305&view=rev
Author:   ggorjan
Date:     2008-12-20 22:34:57 +0000 (Sat, 20 Dec 2008)

Log Message:
-----------


Modified Paths:
--------------
    trunk/gdata/NAMESPACE
    trunk/gdata/inst/NEWS

Added Paths:
-----------
    trunk/gdata/R/trimSum.R
    trunk/gdata/inst/unitTests/runit.trimSum.R
    trunk/gdata/man/trimSum.Rd

Modified: trunk/gdata/NAMESPACE
===================================================================

--- trunk/gdata/NAMESPACE	2008-12-20 22:28:35 UTC (rev 1304)
+++ trunk/gdata/NAMESPACE	2008-12-20 22:34:57 UTC (rev 1305)
@@ -23,6 +23,7 @@
        reorder.factor,
        resample,
        trim,
+	   trimSum,
        unmatrix,
        upperTriangle,
        "upperTriangle<-",

Added: trunk/gdata/R/trimSum.R
===================================================================
--- trunk/gdata/R/trimSum.R	                        (rev 0)
+++ trunk/gdata/R/trimSum.R	2008-12-20 22:34:57 UTC (rev 1305)
@@ -0,0 +1,37 @@
+### trimSum.R
+###------------------------------------------------------------------------
+### What: Sum trimmed values - code
+### $Id$
+### Time-stamp: <2008-12-20 12:11:27 ggorjan>
+###------------------------------------------------------------------------
+
+trimSum <- function(x, n, right=TRUE, na.rm=FALSE, ...)
+{
+  ## --- Setup ---
+
+  if(!is.vector(x) | is.list(x))
+    stop("'x' must be a vector - for now")
+  if(!is.numeric(x))
+    stop("'x' must be numeric")
+  if(length(x) <= n)
+    stop("'n' must be smaller than the length of x")
+  
+  ## --- Trim ---
+
+  N <- length(x)
+  if(right) {
+    x2 <- x[1:n]
+    x2[n] <- sum(x[n:N], na.rm=na.rm)
+  } else {
+    k <- (N - n + 1)
+    x2 <- x[k:N]
+    x2[1] <- sum(x[1:k], na.rm=na.rm)
+  }
+  
+  ## --- Return ---
+
+  x2
+}
+
+###------------------------------------------------------------------------
+### trimSum.R ends here

Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS	2008-12-20 22:28:35 UTC (rev 1304)
+++ trunk/gdata/inst/NEWS	2008-12-20 22:34:57 UTC (rev 1305)
@@ -1,6 +1,8 @@
 CHANGES IN 2.5.0 (2008-??-??)
 -----------------------------
 
+- New function trimSum that sums trimmed values
+
 - New function cbindX that can bind objects with different number of rows.
 
 - write.fwf gains width argument. Unknown values can increase or decrease

Added: trunk/gdata/inst/unitTests/runit.trimSum.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.trimSum.R	                        (rev 0)
+++ trunk/gdata/inst/unitTests/runit.trimSum.R	2008-12-20 22:34:57 UTC (rev 1305)
@@ -0,0 +1,61 @@
+### runit.trimSum.R
+###------------------------------------------------------------------------
+### What: Unit tests for trimSum
+### $Id$
+### Time-stamp: <2008-12-20 11:58:50 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+  library("RUnit")
+  library("gdata")
+}
+
+### }}}
+### {{{ --- trimSum ---
+
+test.trimSum <- function()
+{
+
+  ## 'x' must be a vector - for now
+  checkException(trimSum(matrix(1:10)))
+  checkException(trimSum(data.frame(1:10)))
+  checkException(trimSum(list(1:10)))
+
+  ## 'x' must be numeric
+  checkException(trimSum(letters))
+
+  ## 'n' must be smaller than the length of x
+  checkException(trimSum(x=1:10, n=11))
+  checkException(trimSum(x=1, n=1))
+
+  ## Default
+  x <- trimSum(x=1:10, n=5)
+  x2 <- c(1:4, 45)
+  checkEquals(x, x2)  
+
+  ## Left
+  x <- trimSum(x=1:10, n=5, right=FALSE)
+  x2 <- c(21, 7:10)
+  checkEquals(x, x2)
+
+  ## NA
+  x <- trimSum(x=c(1:9, NA), n=5)
+  x2 <- c(1:4, NA)
+  checkEquals(x, x2)
+  
+  x <- trimSum(x=c(1:9, NA), n=5, na.rm=TRUE)
+  x2 <- c(1:4, 35)
+  checkEquals(x, x2)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.trimSum.R ends here

Added: trunk/gdata/man/trimSum.Rd
===================================================================
--- trunk/gdata/man/trimSum.Rd	                        (rev 0)
+++ trunk/gdata/man/trimSum.Rd	2008-12-20 22:34:57 UTC (rev 1305)
@@ -0,0 +1,52 @@
+% trimSum.Rd
+%--------------------------------------------------------------------------
+% What: Sum trimmed values - help
+% $Id$
+% Time-stamp: <2008-12-20 00:15:57 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{trimSum}
+
+\alias{trimSum}
+
+\title{Trim a vector such that the last/first value represents the sum of 
+  trimmed values}
+
+\description{\code{trimSum} trims (shortens) a vector in such a way that 
+  the last or first value represents the sum of trimmed values. User needs
+  to specify the desired length of a trimmed vector.
+}
+
+\usage{trimSum(x, n, right=TRUE, na.rm=FALSE, \ldots)}
+
+\arguments{
+  \item{x}{numeric, a vector of numeric values}
+  \item{n}{numeric, desired length of the output}
+  \item{right}{logical, trim on the right/bottom  or the left/top  side}
+  \item{na.rm}{logical, remove \code{NA} values when applying a function}
+  \item{\ldots}{arguments passed to other methods - currently not used}
+}
+
+\value{Trimmed vector with a last/first value representing the sum of 
+  trimmed values}
+
+\author{Gregor Gorjanc}
+
+\seealso{\code{\link[gdata]{trim}}}
+
+\examples{
+
+x <- 1:10
+trimSum(x, n=5)
+trimSum(x, n=5, right=FALSE)
+
+x[9] <- NA
+trimSum(x, n=5)
+trimSum(x, n=5, na.rm=TRUE)
+
+}
+
+\keyword{manip}
+
+%--------------------------------------------------------------------------
+% trimSum.Rd ends here


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc:[1305] trunk/gdata

r-gregmisc-users