Erin's new changes

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 <[email protected]>
 Maintainer: Alexander Bessonov <[email protected]>
-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
+

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 = "")))
     }
 } 

R/OREPLACE.R

@@ -1,25 +1,35 @@
-OREPLACE <- function(x, search_string, replace_string = " ") {
+OREPLACE <- function(x, search_char, replace_char) {
     asTdExpr <- function(x) {
         class(x) <- "td.expression"
         return(x)
     }
 
-    rfmt <- "OREPLACE(%s,%s,%s)"
+    rfmt <- "OREPLACE(%s, %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("OREPLACE warning:  td.data.frame 'x' has length > 1 using first element")
-            val <- names(x)[1]
+        if (length(x) == 1 || length(y) == 1) {
+            if (!is.null(attr(x, "expressions")) || !is.null(attr(search_char, "expressions")) || !is.null(attr(replace_char, "expressions"))) { 
+                val1 <- attr(x, "expressions")[[names(x)]]
+                val2 <- attr(search_char, "expressions")[[names(search_char)]]
+                val3 <- attr(replace_char, "expressions")[[names(replace_char)]]
+            }
+            else {
+              val1 <- names(x)
+              val2 <- names(search_char)
+              val3 <- names(replace_char)
+            }
+        } 
+        else {
+            message("OREPLACE warning:  td.data.frame 'x' or 'search_string' or 'replace_string' has length > 1 using first element")
+            val1 <- names(x)[1]
+            val2 <- names(search_char)[1]
+            val3 <- names(replace_char)[1]
         }
 
-        return(asTdExpr(gettextf(rfmt, val, search_string, replace_string)))
+        return(asTdExpr(gettextf(rfmt, val1, val2, val3)))
 
     }
 
     if (inherits(x, "character") || inherits(x, "td.expression")) {
-        return(asTdExpr(paste("OREPLACE(", x, ",", search_string, ",", replace_string, ")", sep = "")))
+        return(asTdExpr(paste("OREPLACE(", val1, ", ", val2, ", ", val3, ")", sep = "")))
     }
 } 

R/OTRANSLATE.R

@@ -1,25 +1,35 @@
-OTRANSLATE <- function(x, from_string, to_string = " ") {
+OTRANSLATE <- function(x, search_char, replace_char) {
     asTdExpr <- function(x) {
         class(x) <- "td.expression"
         return(x)
     }
 
     ofmt <- "OTRANSLATE(%s,%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("OTRANSLATE warning:  td.data.frame 'x' has length > 1 using first element")
-            val <- names(x)[1]
+    if (inherits(x, "td.data.frame") && inherits(search_char, "td.data.frame") && inherits(replace_char, "td.data.frame")) {
+        if (length(x) == 1 && length(search_char) == 1 && length(replace_char) == 1) {
+            if (!is.null(attr(x, "expressions")) || !is.null(attr(search_char, "expressions")) || !is.null(attr(replace_char, "expressions"))) {
+                val1 <- attr(x, "expressions")[[names(x)]] 
+                val2 <- attr(search_char, "expressions")[[names(search_char)]]
+                val3 <- attr(replace_char, "expressions")[[names(replace_char)]]
+            }
+            else {
+              val1 <- names(x)
+              val2 <- names(search_char)
+              val3 <- names(replace_char)
+          } 
         }
-
-        return(asTdExpr(gettextf(ofmt, val, from_string, to_string)))
-
     }
+    else {
+      message("OTRANSLATE warning:  td.data.frame 'x' or 'search_char' or 'replace_char' has length > 1 using first element")
+      val1 <- names(x)[1]
+      val2 <- names(search_char)[1]
+      val3 <- names(replace_char)[1]
+    }
+
+        return(asTdExpr(gettextf(ofmt, val1, val2, val3)))
 
-    if (inherits(x, "character") || inherits(x, "td.expression")) {
-        return(asTdExpr(paste("OTRANSLATE(", x, ",", from_string, ",", to_string, ")", sep = "")))
+    if (inherits(x, "character") || inherits(x, "td.expression") || inherits(search_char, "character") ||
+        inherits(search_char,"td.expression") || inherits(replace_char, "character") || inherits(replace_char, "td.expression")) {
+        return(asTdExpr(paste("OTRANSLATE(", x, ",", search_char, ",", replace_char, ")", sep = "")))
     }
 }