[Analogue-commits] r147 - in pkg: . R inst man

[noreply at r-forge.r-project.org]

Author: gsimpson
Date: 2009-08-16 15:19:38 +0200 (Sun, 16 Aug 2009)
New Revision: 147

Modified:
   pkg/DESCRIPTION
   pkg/R/join.R
   pkg/inst/ChangeLog
   pkg/man/join.Rd
Log:
adds inner join to 'join'.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-08-16 11:52:47 UTC (rev 146)
+++ pkg/DESCRIPTION	2009-08-16 13:19:38 UTC (rev 147)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.6-18
+Version: 0.6-19
 Date: $Date$
 Depends: R (>= 2.5.0), stats, graphics, vegan, lattice, MASS
 Author: Gavin L. Simpson, Jari Oksanen

Modified: pkg/R/join.R
===================================================================
--- pkg/R/join.R	2009-08-16 11:52:47 UTC (rev 146)
+++ pkg/R/join.R	2009-08-16 13:19:38 UTC (rev 147)
@@ -4,7 +4,7 @@
 ##                                                                       ##
 ## Created       : 17-Apr-2006                                           ##
 ## Author        : Gavin Simpson                                         ##
-## Version       : 0.5-0                                                 ##
+## Version       : 0.6-0                                                 ##
 ## Last modified : 16-Aug-2009                                           ##
 ##                                                                       ##
 ## ARGUMENTS:                                                            ##
@@ -37,10 +37,11 @@
 ##                             results of join(..., split = FALSE        ##
 ## 16-Aug-2009 - GLS - 0.5-0 * now has left outer as well as outer join  ##
 ##                           * replacement value can now be specified    ##
+## 16-Aug-2009 - GLS - 0.6-0 * now has inner join capability             ##
 ##                                                                       ##
 ###########################################################################
 join <- function(..., verbose = FALSE, na.replace = TRUE, split = TRUE,
-                  value = 0, type = c("outer","left"))
+                  value = 0, type = c("outer", "left", "inner"))
 {
     outerJoin <- function(X) {
         ## From code provided by Sundar Dorai-Raj in R-Help posting:
@@ -73,6 +74,18 @@
         colnames(joined) <- cn
         return(joined)
     }
+    innerJoin <- function(X) {
+        cn <- lapply(X, colnames)
+        cn <- Reduce(intersect, cn)
+        ##joined <- matrix(NA, ncol = length(cn), nrow = sum(dims[,1]))
+        joined <- vector(length = length(X), mode = "list")
+        for(i in seq_along(joined)) {
+            joined[[i]] <- data.matrix(X[[i]][, cn])
+        }
+        joined <- do.call(rbind, joined)
+        colnames(joined) <- cn
+        return(joined)
+    }
     x <- list(...)
     if(any(!sapply(x, inherits, "data.frame")))
         stop("\nall objects to be merged must be data frames.")
@@ -85,6 +98,8 @@
         joined <- outerJoin(x)
     } else if(type == "left") {
         joined <- leftJoin(x)
+    } else if(type == "inner") {
+        joined <- innerJoin(x)
     }
     if(na.replace) {
         joined[is.na(joined)] <- value

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2009-08-16 11:52:47 UTC (rev 146)
+++ pkg/inst/ChangeLog	2009-08-16 13:19:38 UTC (rev 147)
@@ -1,5 +1,12 @@
 analogue Change Log
 
+Version 0.6-19
+
+	* join: gains ability to return the inner join of the supplied
+	data frames. This is the intersection of the set of variables
+	in the supplied data frames, the set of variables common to the
+	supplied data frames.
+
 Version 0.6-18
 
 	* join: new arguments 'type' and 'value'.

Modified: pkg/man/join.Rd
===================================================================
--- pkg/man/join.Rd	2009-08-16 11:52:47 UTC (rev 146)
+++ pkg/man/join.Rd	2009-08-16 13:19:38 UTC (rev 147)
@@ -12,7 +12,7 @@
 }
 \usage{
 join(\dots, verbose = FALSE, na.replace = TRUE, split = TRUE, value = 0,
-     type = c("outer", "left"))
+     type = c("outer", "left", "inner"))
 
 \method{head}{join}(x, \dots)
 
@@ -46,7 +46,9 @@
     across all the data frames to be merged. \code{"left"} returns the
     left outer (or the left) join, such that the merged data frames
     contain the set of variables found in the first supplied data
-    frame. See Details.}
+    frame. \code{"inner"} returns the inner join, such that the merged
+    data frame contain the intersection of the variables in the supplied
+    data frames. See Details.}
   \item{x}{an object of class \code{"join"}, usually the result of a
     call to \code{\link{join}}.}
 }
@@ -64,6 +66,10 @@
 
   With the \emph{left outer} join the resulting data frame(s) contain
   only the set of variables found in the first data frame provided.
+
+  The \emph{inner} join returns the intersection of the set of variables
+  found in the supplied data frames. The resulting data frame(s)
+  contains the variables common to all supplied data frames.
 }
 \value{
   If \code{split = TRUE}, an object of class \code{"join"}, a list of
@@ -113,6 +119,9 @@
 ## merge training and test set using left join
 head(join(ImbrieKipp, V12.122, verbose = TRUE, type = "left"))
 
+## merge training and test set using inner join
+head(join(ImbrieKipp, V12.122, verbose = TRUE, type = "inner"))
+
 ## merge training and test set using outer join and replace
 ## NA with -99.9
 head(join(ImbrieKipp, V12.122, verbose = TRUE, value = -99.9))