Updates and New Table Operator Wrapper Functions

DESCRIPTION

@@ -2,11 +2,13 @@ Package: teradataR
 Type: Package
 Title: Teradata R Package
 Version: 1.1.0
-Date: 2013-08-01
+Date: 2014-06-29
 Author: Todd Brye <todd.brye@teradata.com>
 Maintainer: Alexander Bessonov <alexander.bessonov@teradata.com>
-Depends: R (>= 2.11.0), RJDBC, RODBC
+Depends: R (>= 2.11.0)
+Suggests: RODBC (>= 1.3-9), RJDBC (>= 0.2-1)
 Description: This package allows you you access a Teradata database using the R language.  It allows programmers familiar with R to analyze Teradata objects a lot like they would access a data frame object.
 License: GPL (>= 2)
 LazyLoad: yes
-Packaged: 2013-08-01 15:36:00 UTC; nonsleepr
+Packaged: 2014-06-29 00:33:50 MSK; nonsleepr
+

NAMESPACE

@@ -1,18 +1,84 @@
-export(as.data.frame.td.data.frame, as.td.data.frame,
-dim.td.data.frame, hist.td.data.frame, is.td.data.frame,
-max.td.data.frame, mean.td.data.frame, median.td.data.frame,
-min.td.data.frame, print.td.data.frame, sum.td.data.frame,
-summary.td.data.frame, td.bincode, td.binomial, td.binomialsign,
-td.call.sp, td.cor, td.cov, td.dagostino.pearson, td.data.frame,
-td.f.oneway, td.factanal, td.freq, td.hist, td.join, td.ks,
-td.lilliefors, td.merge, td.mode, td.mwnkw, td.nullreplace,
-td.overlap, td.quantiles, td.rank, td.recode, td.rescale,
-td.sample, td.shapiro.wilk, td.sigmoid, td.smirnov, td.solve,
-td.stats, td.t.paired, td.t.unpaired, td.t.unpairedi, td.values,
-td.wilcoxon, td.zscore, tdClose, tdConnect, tdMetadataDB, tdQuery,
-tdSave, td.kmeans, predict.kmeans, ASCII, CEIL, CHR, DECODE, EDITDISTANCE,
-FLOOR, INSTR, INTCAP, LENGTH, LPAD, LTRIM, NGRAM, OREPLACE,OTRANSLATE,
-RPAD, RTRIM, Ops.td.data.frame, Ops.td.expression, is.td.expression,
-GREATEST, LEAST, td.tapply, subset.td.data.frame, tdQueryUpdate)
+export(
+  as.data.frame.td.data.frame, 
+  as.td.data.frame,
+  dim.td.data.frame, 
+  hist.td.data.frame, 
+  is.td.data.frame,
+  max.td.data.frame, 
+  mean.td.data.frame, 
+  median.td.data.frame,
+  min.td.data.frame,
+  print.td.data.frame,
+  sum.td.data.frame,
+  summary.td.data.frame,
+  td.bincode,
+  td.binomial,
+  td.binomialsign,
+  td.call.sp,
+  td.cor,
+  td.cov,
+  td.dagostino.pearson,
+  td.data.frame,
+  td.f.oneway, 
+  td.factanal,
+  td.freq,
+  td.hist,
+  td.join,
+  td.ks,
+  td.lilliefors,
+  td.merge,
+  td.mode, 
+  td.mwnkw,
+  td.nullreplace,
+  td.overlap,
+  td.quantiles,
+  td.rank,
+  td.recode,
+  td.rescale,
+  td.sample,
+  td.shapiro.wilk,
+  td.sigmoid,
+  td.smirnov,
+  td.solve,
+  td.stats,
+  td.t.paired,
+  td.t.unpaired,
+  td.t.unpairedi,
+  td.values,
+  td.wilcoxon,
+  td.zscore,
+  tdClose,
+  tdConnect,
+  tdMetadataDB,
+  tdQuery,
+  tdSave,
+  td.kmeans,
+  predict.kmeans,
+  ASCII,
+  CEIL,
+  CHR,
+  DECODE,
+  EDITDISTANCE,
+  FLOOR,
+  INSTR,
+  INITCAP,
+  LENGTH,
+  LPAD,
+  LTRIM,
+  NGRAM,
+  OREPLACE, 
+  OTRANSLATE,
+  RPAD,
+  RTRIM,
+  Ops.td.data.frame,
+  Ops.td.expression,
+  is.td.expression,
+  GREATEST,
+  LEAST,
+  td.tapply,
+  subset.td.data.frame,
+  tdQueryUpdate,
+  td.ExecR,
+  on)
 S3method("[", td.data.frame)
 S3method("[<-", td.data.frame)

R/CEIL.R

@@ -7,7 +7,7 @@ CEIL <- function(x) {
     } else if (inherits(x, "td.expression") || inherits(x, "numeric")) 
         val <- paste("CEIL(", x, ")", sep = "") else if (inherits(x, "character")) 
         val <- paste("CEIL('", x, "')", sep = "") else stop("Invalid data type for 'x' in CEIL function")
-    
+
     class(val) <- "td.expression"
     return(val)
 }

R/CHR.R

@@ -11,10 +11,3 @@ CHR <- function(x) {
     class(val) <- "td.expression"
     return(val)
 }
-
-# CHR <- function(x) { if(inherits(x, 'td.data.frame')) { if(length(x) == 1) if(!is.null(attr(x, 'expressions'))) { val
-# <- paste('CHR(', attr(x, 'expressions')[[names(x)]], ')', sep='') class(val) <- 'td.expression' return(val) } else {
-# val <- paste('CHR(\'', names(x), '\')', sep='') class(val) <- 'td.expression' return(val) } else { message('CHR
-# warning: td.data.frame 'x' has length > 1 using first element') val <- paste('CHR(\'', names(x)[1], '\')', sep='')
-# class(val) <- 'td.expression' return(val) } } if(inherits(x, 'numeric') || inherits(x, 'character') ||
-# inherits(x,'td.expression')) { val <- paste('CHR(', x, ')', sep='') class(val) <- 'td.expression' return(val) } } 

R/DECODE.R

@@ -1,30 +1,30 @@
-DECODE <- function(x, ...) {
-    parms <- list(...)
-    for (i in 1:length(parms)) {
-        if (is.character(parms[[i]])) 
-            parms[[i]] <- paste("'", parms[[i]], "'", sep = "")
+DECODE <- function(x, default=NULL, ...) {
+    simplePaste <- function(i) {
+      if(inherits(i, "numeric")) {
+        res <- as.numeric(paste(i))
+      }
+      else {
+        res <- paste("'",i,"'", sep="")
+      }
+      return(res)
     }
-    plist <- paste(parms, collapse = ",")
-
+    params <- list(...)
+    res <- lapply(params, simplePaste)
+    res <- paste(res, collapse=",")
     if (inherits(x, "td.data.frame")) {
-        if (length(x) > 1) 
+        if (length(x) > 1) {
             message("DECODE warning:  td.data.frame 'x' has length > 1 using first element")
-
-        val <- paste("DECODE(", .td.gencolumnexpr(x[1]), ",", plist, ")", sep = "")
-    } else if (inherits(x, "td.expression") || inherits(x, "numeric")) 
-        val <- paste("DECODE(", x, ",", plist, ")", sep = "") else if (inherits(x, "character")) 
-        val <- paste("DECODE('", x, "'", ",", plist, ")", sep = "") else stop("Invalid data type for 'x' in DECODE function")
-
-    class(val) <- "td.expression"
-    return(val)
-}
-
-# DECODE <- function(x, ...) { parms <- list(...)  for(i in 1:length(parms)) { if(is.character(parms[[i]])) parms[[i]]
-# <- paste(''', parms[[i]], ''', sep='') } plist <- paste(parms, collapse=',') if(inherits(x, 'td.data.frame')) {
-# if(length(x) == 1) { if(!is.null(attr(x, 'expressions')) && names(x) %in% names(attr(x,'expressions'))) { val <-
-# paste('DECODE(', attr(x, 'expressions')[[names(x)]], ',', plist, ')', sep='') class(val) <- 'td.expression'
-# return(val) } else { val <- paste('DECODE(\'', names(x), '\',', plist, ')', sep='') class(val) <- 'td.expression'
-# return(val) } } else { message('DECODE warning: td.data.frame 'x' has length > 1 using first element') val <-
-# paste('DECODE(\'', names(x)[1], ',', plist, '\')', sep='') class(val) <- 'td.expression' return(val) } }
-# if(inherits(x, 'character') || inherits(x,'td.expression')) { val <- paste('DECODE(', x, ',', plist, ')', sep='')
-# class(val) <- 'td.expression' return(val) } } 
+        }
+        val <- paste("DECODE(", .td.gencolumnexpr(x[1]), ",", res, ",'", default, "')", sep = "")
+    } 
+   else if (inherits(x, "td.expression") || inherits(x, "numeric")) {
+        val <- paste("DECODE(", x, ",", res, ",'", default, "')", sep = "") 
+   }
+   else if (inherits(x, "character")) {
+        val <- paste("DECODE('", x, "'", ",", res, ",'", default, "')", sep = "") 
+   }    
+   else stop("Invalid data type for 'x' in DECODE function")
+
+   class(val) <- "td.expression"
+   return(val)
+}

R/INITCAP.R

@@ -0,0 +1,17 @@
+INITCAP <- function(x) {
+  #handles condition in which x is a td data frame  
+  if (inherits(x, "td.data.frame")) {
+        if (length(x) > 1) 
+            message("INITCAP warning:  td.data.frame 'x' has length > 1 using first element")
+
+        #sets up query expression
+        val <- paste("INITCAP(", .td.gencolumnexpr(x[1]), ")", sep = "")
+   #handles condition in which x is a td expression or numeric 
+   }
+   else if (inherits(x, "td.expression") || inherits(x, "numeric") || inherits(x, "character")) 
+        val <- paste("INITCAP(", x, ")", sep = "") 
+    else stop("Invalid data type for 'x' in INITCAP function")
+
+    class(val) <- "td.expression"
+    return(val)
+}

R/INSTR.R

@@ -1,4 +1,5 @@
 INSTR <- function(x, y) {
+    # check type of x 
     if (inherits(x, "td.data.frame")) {
         if (length(x) > 1) 
             message("INSTR warning:  td.data.frame 'x' has length > 1 using first element")
@@ -8,6 +9,7 @@ INSTR <- function(x, y) {
         xval <- x else if (inherits(x, "character")) 
         xval <- paste("'", x, "'", sep = "") else stop("Invalid data type for 'x' in INSTR function")
 
+    # check type of y
     if (inherits(y, "td.data.frame")) {
         if (length(y) > 1) 
             message("INSTR warning:  td.data.frame 'y' has length > 1 using first element")
@@ -22,12 +24,4 @@ INSTR <- function(x, y) {
 
     class(val) <- "td.expression"
     return(val)
-}
-
-
-# INSTR <- function(x, search_string=' ') { asTdExpr <- function(x) {class(x) <- 'td.expression'; return(x)} ifmt <-
-# 'INSTR(%s,%s)' if(inherits(x, 'td.data.frame')) { if(length(x) == 1) { if(!is.null(attr(x, 'expressions'))) val <-
-# attr(x, 'expressions')[[names(x)]] else val <- names(x) } else { message('INSTR warning: td.data.frame 'x' has length
-# > 1 using first element') val <- names(x)[1] } return(asTdExpr(gettextf(ifmt, val, search_string))) } if(inherits(x,
-# 'character') || inherits(x,'td.expression')) { return(asTdExpr(paste('INSTR(', x, ',', search_string, ')', sep='')))
-# } } 
+}

R/LPAD.R

@@ -1,10 +1,12 @@
 LPAD <- function(x, ilength, fill_string = " ") {
+    #helper function to make sure input value is of correct type
     asTdExpr <- function(x) {
         class(x) <- "td.expression"
         return(x)
     }
 
-    lfmt <- "LPAD(%s,%d,%s)"
+    lfmt <- "LPAD(\"%s\",%d,\'%s\')"
+    #handles conditions in which x is a td data frame
     if (inherits(x, "td.data.frame")) {
         if (length(x) == 1) {
             if (!is.null(attr(x, "expressions"))) 
@@ -18,8 +20,8 @@ LPAD <- function(x, ilength, fill_string = " ") {
         return(asTdExpr(gettextf(lfmt, val, ilength, fill_string)))
 
     }
-
+    #handles conditions in which x is a character or td expression
     if (inherits(x, "character") || inherits(x, "td.expression")) {
-        return(asTdExpr(paste("LPAD(", x, ",", ilength, ",", fill_string, ")", sep = "")))
+        return(asTdExpr(paste("LPAD(\"", x, "\",", ilength, ",", fill_string, ")", sep = " ")))
     }
 } 

R/LTRIM.R

@@ -1,11 +1,11 @@
-LTRIM <- function(x, rstring = " ") {
+LTRIM <- function(x) {
     asTdExpr <- function(x) {
         class(x) <- "td.expression"
         return(x)
     }
 
-    lfmt <- "LTRIM(%s,%s)"
-    if (inherits(x, "td.data.frame")) {
+    lfmt <- "LTRIM(%s)"
+
         if (length(x) == 1) {
             if (!is.null(attr(x, "expressions"))) 
                 val <- attr(x, "expressions")[[names(x)]] else val <- names(x)
@@ -14,12 +14,5 @@ LTRIM <- function(x, rstring = " ") {
             message("LTRIM warning:  td.data.frame 'x' has length > 1 using first element")
             val <- names(x)[1]
         }
-
-        return(asTdExpr(gettextf(lfmt, val, rstring)))
-
-    }
-
-    if (inherits(x, "character") || inherits(x, "td.expression")) {
-        return(asTdExpr(paste("LTRIM(", x, ",", fill_string, ")", sep = "")))
-    }
-} 
+            return(asTdExpr(gettextf(lfmt, val)))
+}

R/NGRAM.R

@@ -1,25 +1,33 @@
-NGRAM <- function(x, second_string, gram_length) {
+NGRAM <- function(x, y, gram_length) {
+    #helper function acts as a setter for class td.expression
     asTdExpr <- function(x) {
         class(x) <- "td.expression"
         return(x)
     }
-
+    #set up base text
     ofmt <- "NGRAM(%s,%s,%d)"
-    if (inherits(x, "td.data.frame")) {
-        if (length(x) == 1) {
-            if (!is.null(attr(x, "expressions"))) 
-                val <- attr(x, "expressions")[[names(x)]] else val <- names(x)
-
-        } else {
-            message("NGRAM warning:  td.data.frame 'x' has length > 1 using first element")
-            val <- names(x)[1]
+    #determine datatype of parameters
+    if (inherits(x, "td.data.frame") || inherits(y, "td.data.frame")) {
+        if (length(x) == 1 && length(y) == 1) {
+            if (!is.null(attr(x, "expressions")) && (!is.null(attr(y, "expressions")))) {
+                val1 <- attr(x, "expressions")[[names(x)]] 
+                val2 <- attr(y, "expressions")[[names(y)]]
+            }
+            else {
+                val1 <- names(x)
+                val2 <- names(y)
+            }
         }
-
-        return(asTdExpr(gettextf(ofmt, val, second_string, gram_length)))
+        else {
+            message("NGRAM warning:  td.data.frame 'x' or 'y' has length > 1 using first element")
+            val1 <- names(x)[1]
+            val2 <- names(y)[1]
+        }
+        return(asTdExpr(gettextf(ofmt, val1, val2, gram_length)))
 
     }
-
-    if (inherits(x, "character") || inherits(x, "td.expression")) {
-        return(asTdExpr(paste("NGRAM(", x, ",", second_string, ",", gram_length, ")", sep = "")))
+    #check for other datatypes
+    if (inherits(x, "character") || inherits(x, "td.expression") || inherits(y, "character") || inherits(y, "td.expression")) {
+        return(asTdExpr(paste("NGRAM(", x, ",",y, ",", gram_length, ")", sep = "")))
     }
 }