diff --git a/DESCRIPTION b/DESCRIPTION index acf84c1..c422b9e 100755 --- a/DESCRIPTION +++ b/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 Maintainer: Alexander Bessonov -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 + diff --git a/NAMESPACE b/NAMESPACE index 7486800..eb62367 100755 --- a/NAMESPACE +++ b/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) diff --git a/R/CEIL.R b/R/CEIL.R index bd534aa..04aeceb 100755 --- a/R/CEIL.R +++ b/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) } diff --git a/R/CHR.R b/R/CHR.R index d436992..acb15e8 100755 --- a/R/CHR.R +++ b/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) } } diff --git a/R/DECODE.R b/R/DECODE.R index e52c539..9498adb 100755 --- a/R/DECODE.R +++ b/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) +} \ No newline at end of file diff --git a/R/INITCAP.R b/R/INITCAP.R new file mode 100755 index 0000000..4d4cb6a --- /dev/null +++ b/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) +} \ No newline at end of file diff --git a/R/INSTR.R b/R/INSTR.R index 1e61ca6..8ad03fe 100755 --- a/R/INSTR.R +++ b/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=''))) -# } } +} \ No newline at end of file diff --git a/R/INTCAP.R b/R/INTCAP.R deleted file mode 100755 index 2139d7d..0000000 --- a/R/INTCAP.R +++ /dev/null @@ -1,21 +0,0 @@ -INTCAP <- function(x) { - if (inherits(x, "td.data.frame")) { - if (length(x) > 1) - message("INTCAP warning: td.data.frame 'x' has length > 1 using first element") - - val <- paste("INTCAP(", .td.gencolumnexpr(x[1]), ")", sep = "") - } else if (inherits(x, "td.expression") || inherits(x, "numeric")) - val <- paste("INTCAP(", x, ")", sep = "") else if (inherits(x, "character")) - val <- paste("INTCAP('", x, "')", sep = "") else stop("Invalid data type for 'x' in INTCAP function") - - class(val) <- "td.expression" - return(val) -} - - -# INTCAP <- function(x) { asTdExpr <- function(x) {class(x) <- 'td.expression'; return(x)} if(inherits(x, -# 'td.data.frame')) { if(length(x) == 1) if(!is.null(attr(x, 'expressions'))) return(asTdExpr(paste('INTCAP(', attr(x, -# 'expressions')[[names(x)]], ')', sep=''))) else return(asTdExpr(paste('INTCAP(\'', names(x), '\')', sep=''))) else -# { message('INTCAP warning: td.data.frame 'x' has length > 1 using first element') return(asTdExpr(paste('INTCAP(\'', -# names(x)[1], '\')', sep=''))) } } if(inherits(x, 'character') || inherits(x,'td.expression')) { -# return(asTdExpr(paste('INTCAP(', x, ')', sep=''))) } } diff --git a/R/LPAD.R b/R/LPAD.R index 9079c0f..f8827b1 100755 --- a/R/LPAD.R +++ b/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 = " "))) } } diff --git a/R/LTRIM.R b/R/LTRIM.R index c10d169..8b60d73 100755 --- a/R/LTRIM.R +++ b/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))) +} diff --git a/R/NGRAM.R b/R/NGRAM.R index 06c4e30..c474ada 100755 --- a/R/NGRAM.R +++ b/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 = ""))) } } diff --git a/R/OREPLACE.R b/R/OREPLACE.R index 5c40b79..3715c67 100755 --- a/R/OREPLACE.R +++ b/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 = ""))) } } diff --git a/R/OTRANSLATE.R b/R/OTRANSLATE.R index fa5b372..1210b42 100755 --- a/R/OTRANSLATE.R +++ b/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 = ""))) } } diff --git a/R/POWER.R b/R/POWER.R index 861c888..2cdbc28 100755 --- a/R/POWER.R +++ b/R/POWER.R @@ -4,22 +4,33 @@ POWER <- function(x, exponent = 1) { return(x) } - pfmt <- "POWER(CAST(%s AS FLOAT),%d)" + pfmt <- "POWER(%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("POWER warning: td.data.frame 'x' has length > 1 using first element") - val <- names(x)[1] + if (length(x) == 1 || length(exponent) == 1) { + if (!is.null(attr(x, "expressions"))) { + val1 <- attr(x, "expressions")[[names(x)]] + } + else { + val1 <- names(x) + } + if (!is.null(attr(exponent, "expressions"))) { + val2 <- attr(exponent, "expressions")[[names(exponent)]] + } + else { + val2 <- names(exponent) + } + } + else { + message("POWER warning: td.data.frame 'x' or 'exponent' has length > 1 using first element") + val1 <- names(x)[1] + val2 <- names(exponent)[1] } - return(asTdExpr(gettextf(pfmt, val, exponent))) + return(asTdExpr(gettextf(pfmt, val1, val2))) } if (inherits(x, "character") || inherits(x, "td.expression")) { - return(asTdExpr(paste("POWER(CAST(", x, " AS FLOAT),", exponent, ")", sep = ""))) + return(asTdExpr(paste("POWER(", x, exponent, ")", sep = ""))) } } diff --git a/R/RPAD.R b/R/RPAD.R index e63d32a..3fc2fd6 100755 --- a/R/RPAD.R +++ b/R/RPAD.R @@ -4,7 +4,7 @@ RPAD <- function(x, ilength, fill_string = " ") { return(x) } - rfmt <- "RPAD(%s,%d,%s)" + rfmt <- "RPAD(\"%s\",%d,\'%s\')" if (inherits(x, "td.data.frame")) { if (length(x) == 1) { if (!is.null(attr(x, "expressions"))) @@ -20,6 +20,6 @@ RPAD <- function(x, ilength, fill_string = " ") { } if (inherits(x, "character") || inherits(x, "td.expression")) { - return(asTdExpr(paste("RPAD(", x, ",", ilength, ",", fill_string, ")", sep = ""))) + return(asTdExpr(paste("RPAD(\"", x, "\",", ilength, ",", fill_string, ")", sep = ""))) } } diff --git a/R/RTRIM.R b/R/RTRIM.R index 5181c67..fe96314 100755 --- a/R/RTRIM.R +++ b/R/RTRIM.R @@ -1,10 +1,10 @@ -RTRIM <- function(x, rstring = " ") { +RTRIM <- function(x) { asTdExpr <- function(x) { class(x) <- "td.expression" return(x) } - rfmt <- "RTRIM(%s,%s)" + rfmt <- "RTRIM(%s)" if (inherits(x, "td.data.frame")) { if (length(x) == 1) { if (!is.null(attr(x, "expressions"))) @@ -15,11 +15,6 @@ RTRIM <- function(x, rstring = " ") { val <- names(x)[1] } - return(asTdExpr(gettextf(rfmt, val, rstring))) - - } - - if (inherits(x, "character") || inherits(x, "td.expression")) { - return(asTdExpr(paste("RTRIM(", x, ",", fill_string, ")", sep = ""))) - } -} + return(asTdExpr(gettextf(rfmt, val))) + } +} \ No newline at end of file diff --git a/R/TO_CHAR.R b/R/TO_CHAR.R index 4e583e3..9acf2ce 100755 --- a/R/TO_CHAR.R +++ b/R/TO_CHAR.R @@ -1,25 +1,36 @@ -TO_CHAR <- function(x, format = " ") { +TO_CHAR <- function(x, format) { asTdExpr <- function(x) { class(x) <- "td.expression" return(x) } - tfmt <- "TO_CHAR(%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("TO_CHAR warning: td.data.frame 'x' has length > 1 using first element") - val <- names(x)[1] + tfmt <- "TO_CHAR(%s, %s)" + if (inherits(x, "td.data.frame") || inherits(format, "td.data.frame")) { + if (length(x) == 1 || length(format) == 1) { + if (!is.null(attr(x, "expressions"))) { + val1 <- attr(x, "expressions")[[names(x)]] + } + else { + val1 <- names(x) + } + if (!is.null(attr(format, "expressions"))) { + val2 <- attr(format, "expressions")[[names(format)]] + } + else { + val2 <- names(format) + } + } + else { + message("TO_CHAR warning: td.data.frame 'x' or 'format' has length > 1 using first element") + val1 <- names(x)[1] + val2 <- names(format)[1] } - return(asTdExpr(gettextf(tfmt, val, format))) + return(asTdExpr(gettextf(tfmt, val1, val2))) } if (inherits(x, "character") || inherits(x, "td.expression")) { - return(asTdExpr(paste("TO_CHAR(", x, ",", format, ")", sep = ""))) + return(asTdExpr(paste("TO_CHAR(", x, format, ")", sep = ""))) } } diff --git a/R/as.td.data.frame.R b/R/as.td.data.frame.R index 8d18d24..ef78b80 100755 --- a/R/as.td.data.frame.R +++ b/R/as.td.data.frame.R @@ -1,5 +1,5 @@ as.td.data.frame <- function(x, ...) { - if (inherits(x, "td.data.frame")) { + if (inherits(x, "td.data.frame")) { args <- list(...) if (is.null(args[["tableName"]])) tbl <- deparse(substitute(x)) else tbl <- args[["tableName"]] @@ -13,6 +13,7 @@ as.td.data.frame <- function(x, ...) { query <- gettextf("CREATE TABLE %s AS (%s) WITH DATA", oObj, selectText) df <- try(tdQueryUpdate(query)) if (length(df) == 1L && df == "No Data") + return(td.data.frame(tbl, oDatabase)) else stop(gettextf("Error: %s", paste(df, collapse = ""))) } if (inherits(x, "data.frame")) { diff --git a/R/on.R b/R/on.R new file mode 100755 index 0000000..79e2a28 --- /dev/null +++ b/R/on.R @@ -0,0 +1,41 @@ +on <- function(target=NULL, from=NULL, subQuery=NULL, partition=NULL, hash=NULL, order=NULL, local_order=NULL, null_order=NULL, dimension=NULL, as=NULL) { + if(!is.null(subQuery)) { + baseText <- paste("on %s%s%s%s", subQuery, "%s") + } + else { + baseText <- "on %s%s%s%s%s" + } + if (grepl("select", target)) { + if(!is.null(from)) { + returnString <- gettextf(baseText, "(", target," from ", from, ")") + } + else { + returnString <- gettextf(baseText, "(", target, ")", "", "") + } + } + else { + returnString <- gettextf(baseText, target, "", "", "", "","") + } + + if(!is.null(as)) { + returnString <- paste(returnString, .td.makeAs(as), sep="\n") + } + if (!is.null(partition)) { + returnString <- paste( returnString, .td.makePartition(partition), sep = "\n") + } + if (!is.null(hash)) { + returnString <- paste(returnString, .td.makeHash(hash), sep="\n") + } + if (!is.null(order)) { + returnString <- paste(returnString, .td.makeOrder(order), sep="\n") + } + + if (!is.null(local_order)) { + returnString <- paste(returnString, .td.makeLocalOrder(null_order, local_order), sep="\n") + } + if (!is.null(dimension)) { + returnString <- paste(returnString, .td.makeDimension(), sep="\n") + } + returnString <- gsub(";", "", returnString) + return(returnString) +} diff --git a/R/td.CalcMatrix.R b/R/td.CalcMatrix.R new file mode 100755 index 0000000..c242036 --- /dev/null +++ b/R/td.CalcMatrix.R @@ -0,0 +1,10 @@ +td.CalcMatrix <- function(selectPhrase=string, ons=string, phase=NULL, calctype=NULL, output=NULL, null_handling=NULL, optional_operators=NULL, as=NULL) { + + ons <- unlist(ons) + ons <- paste(ons, sep="", collapse="\n") + using <- .td.usingClause(phase=phase, calctype=calctype, output=output, null_handling=null_handling) + queryText <- paste(selectPhrase, "(\n", ons, using, ") ", optional_operators, " as ", as, ";") + + print(queryText) + return(queryText) +} diff --git a/R/td.ExecR.R b/R/td.ExecR.R new file mode 100755 index 0000000..606ed9e --- /dev/null +++ b/R/td.ExecR.R @@ -0,0 +1,8 @@ +td.ExecR <- function(selectPhrase=string, ons=list(), returns=NULL, contract=NULL, operator=string, optional_operators=NULL) { + ons<- unlist(ons) + ons <- paste(ons, sep="", collapse="\n") + using <- .td.usingClause(returns=returns, contract=contract, operator=operator) + queryText <- paste(selectPhrase, "(\n", ons, "\n", using, optional_operators, "\n) as db;") + + return(queryText) +} \ No newline at end of file diff --git a/R/td.data.frame.R b/R/td.data.frame.R index 1e23908..19a7d1d 100755 --- a/R/td.data.frame.R +++ b/R/td.data.frame.R @@ -4,7 +4,7 @@ td.data.frame <- function(table, database = "") { query <- gettextf("SELECT * FROM %s SAMPLE 0", obj) res <- try(tdQuery(query)) if (is.null(attr(res, "class"))) { - res <- data.frame() + res <- data.frame(stringsAsFactors = FALSE) attr(res, "totalRows") <- 0 warning("Teradata table not found. Result is empty data frame.") } else { diff --git a/R/td.kmeans.R b/R/td.kmeans.R index 345f630..d49ab3f 100755 --- a/R/td.kmeans.R +++ b/R/td.kmeans.R @@ -16,7 +16,7 @@ td.kmeans <- function(x, centers, iter.max = 10, nstart = 1) { nms <- paste(gettextf("\"%s\"", names(x)), collapse = ",") maxD <- 0 for (i in 1:nstart) { - testClusters <- tdQuery(gettextf("SELECT %s FROM %s %s SAMPLE %d", nms, obj, wc, centers)) + testClusters <- tdQuery(gettextf("SELECT DISTINCT %s FROM %s %s SAMPLE %d", nms, obj, wc, centers)) curD <- 0 for (j in 1:centers - 1) { for (k in (j + 1):centers) curD <- curD + sum(dist(testClusters[c(j, k), ])) diff --git a/R/td.sample.R b/R/td.sample.R index 5ecbb6e..646e5fb 100755 --- a/R/td.sample.R +++ b/R/td.sample.R @@ -15,8 +15,11 @@ td.sample <- function(tdf, sizes = missing, oTable = "", oDatabase = "") { if (.td.objectExists(oObj)) stop(gettextf("Table %s already exists.", oObj)) query <- gettextf("CREATE TABLE %s AS (%s) WITH DATA", oObj, query) + df <- try(tdQueryUpdate(query)) + } else { + df <- try(tdQuery(query)) } - df <- try(tdQueryUpdate(query)) + if (is.data.frame(df)) return(df) if (length(df) == 1L && df == "No Data") diff --git a/R/tdQuery.R b/R/tdQuery.R index 1f2d594..eba0a7b 100755 --- a/R/tdQuery.R +++ b/R/tdQuery.R @@ -1,6 +1,6 @@ tdQuery <- function(q, ...) { if (class(tdConnection) == "RODBC") - return(sqlQuery(tdConnection, q, ...)) + return(sqlQuery(tdConnection, q, stringsAsFactors=FALSE, ...)) if (class(tdConnection) == "JDBCConnection") return(dbGetQuery(tdConnection, q, ...)) } diff --git a/R/teradataR-internal.R b/R/teradataR-internal.R index 02e9e17..a50770d 100755 --- a/R/teradataR-internal.R +++ b/R/teradataR-internal.R @@ -884,3 +884,98 @@ return(query) } + +.td.makeHash <- function(...) { + baseText = "hash by %s" + dependents = paste(...) + return(gettextf(baseText, dependents)) +} + +.td.makePartition <- function(...) { + baseText = "partition by %s" + dependents = paste(...) + return(gettextf(baseText, dependents)) +} + +.td.makeOrder <- function(...) { + baseText = "order by %s" + dependents = paste(...) + return(gettextf(baseText, dependents)) +} + +.td.makeLocalOrder <- function(null_order=NULL, local_order=NULL, ...) { + baseText = "local order by %s" + if (!is.null(nullOrder)) { + specialValue = paste(nullOrder) + orderByList = paste(...) + dependents = paste(orderByList, specialValue) + return(gettextf(baseText, dependents)) + } + else { + dependents = paste(...) + return(gettextf(baseText, dependents)) + } +} + +.td.makeDimension <- function() { + baseText = "dimension" + return(baseText) +} + +.td.makeAs <- function(...) { + baseText = "as %s" + dependents = paste(...) + return(gettextf(baseText, dependents)) +} + +.td.getOperator <- function(operator){ + if (!is.character(operator) || nchar(operator) == 0){ + stop("operator argument must be a character vector") + } + + if (file.exists(operator)){ + return (readChar(operator, file.info(operator)$size)) + } else { + return (operator) + } +} + +.td.getContract <- function(contract){ + if (!is.character(contract) || nchar(contract) == 0){ + stop("contract argument must be a character vector") + } + + if (file.exists(contract)){ + return (readChar(contract, file.info(contract)$size)) + } else { + return (contract) + } +} + +# Currently only supporting Returns/Operator/Contract USING clauses +.td.usingClause <- function(operator, returns=NULL, contract=NULL){ + + if (is.null(returns) && is.null(contract)){ + stop("ExecR must have either returns or contract arguments but not both") + } + + if (nchar(operator) == 0){ + stop("Operator for ExecR must be provided") + } + + if (is.null(contract)){ + + if (!is.atomic(returns) && !is.character(returns)){ + stop("returns argument must be a character vector") + } + + baseText = "RETURNS (%s) USING \n Operator('%s')" + return (res <- gettextf(baseText, paste(returns, collapse = ', '), .td.getOperator(operator))) + + } else{ + + baseText = "USING \n Contract('\n%s') \n Operator('\n%s')" + return(gettextf(baseText, .td.getContract(contract), .td.getOperator(operator))) + + } +} \ No newline at end of file diff --git a/README.md b/README.md index 8669b92..e0be237 100644 --- a/README.md +++ b/README.md @@ -4,3 +4,20 @@ teradataR R package to perform in-database analytics using Teradata database. Compatible with both R version 2 and 3. + +Prebuilt package could be found [here](https://github.com/Teradata/teradataR/raw/master/build/teradataR_1.1.0.tar.gz). + +## Dependencies + ++ RJDBC + + rJava ++ RODBC + +## Installation + +To install the package, issue the following command from R REPL: + + install.packages("C:\\Documents and Settings\\User\\My Documents\\Downloads\\teradataR_1.1.0.tar.gz", repos=NULL,type="source"); + +Where first argument is the path to the package file. + diff --git a/build/teradataR_1.1.0.tar.gz b/build/teradataR_1.1.0.tar.gz index 6fea732..3296158 100644 Binary files a/build/teradataR_1.1.0.tar.gz and b/build/teradataR_1.1.0.tar.gz differ diff --git a/man/INITCAP.Rd b/man/INITCAP.Rd new file mode 100644 index 0000000..1b4f258 --- /dev/null +++ b/man/INITCAP.Rd @@ -0,0 +1,46 @@ +\name{INITCAP} +\alias{INITCAP} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper Function INITCAP +} +\description{ +Makes a wrapper around the fastpath function INITCAP +} +\usage{ +INITCAP(x) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +a teradata dataframe that contains columns of characters that will be capitalized +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A teradata data frame of the columns that have their first letters capitalized +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Todd Brye, Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +tdf["col2"] <- INITCAP(tdf["col1"]) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/LPAD.Rd b/man/LPAD.Rd new file mode 100644 index 0000000..0e86e96 --- /dev/null +++ b/man/LPAD.Rd @@ -0,0 +1,52 @@ +\name{LPAD} +\alias{LPAD} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper Function LPAD +} +\description{ +Makes a wrapper around the fastpath function LPAD +} +\usage{ +LPAD(x, ilength, fill_string = " ") +} +%- maybe also 'usage' for other objects documented here. +\arguments{ +\item{x}{ +a teradata dataframe that contains column(s) of characters that will be padded +} +\item{ilength}{ +the amount of padding to append to the beginning of the character +} +\item{fill_string}{ +the character used to pad the the column(s) of characters that are passed into the function. Default character is the empty character +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A teradata data frame of the columns that have been padded at the beginning +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Todd Brye, Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +tdf["col2"] <- LPAD(tdf["col1", 15, " "]) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/LTRIM.Rd b/man/LTRIM.Rd new file mode 100644 index 0000000..745915a --- /dev/null +++ b/man/LTRIM.Rd @@ -0,0 +1,47 @@ +\name{LTRIM} +\alias{LTRIM} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper Function LTRIM +} +\description{ +Makes a wrapper around the fastpath function LTRIM +} +\usage{ +LTRIM(x) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +a teradata dataframe that contains column(s) of characters whose padding to their left will be trimmed +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A teradata data frame of the columns that will be trimmed at the beginning of each character +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Todd Brye, Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +tdf["col2"] <- LTRIM(tdf["col1"]) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/RPAD.Rd b/man/RPAD.Rd new file mode 100644 index 0000000..a1070c7 --- /dev/null +++ b/man/RPAD.Rd @@ -0,0 +1,52 @@ +\name{RPAD} +\alias{RPAD} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper Function RPAD +} +\description{ +Makes a wrapper around the fastpath function RPAD +} +\usage{ +RPAD(x, ilength, fill_string = " ") +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +a teradata dataframe that contains column(s) of characters that will be padded +} +\item{ilength}{ +the amount of padding to append to the beginning of the character +} +\item{fill_string}{ +the character used to pad the the column(s) of characters that are passed into the function. Default character is the empty character +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A teradata data frame of the columns that will be padded at the beginning of each character +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Todd Brye, Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +tdf["col2"] <- RPAD(tdf["col1", 15, " "]) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/RTRIM.Rd b/man/RTRIM.Rd new file mode 100644 index 0000000..9bffe06 --- /dev/null +++ b/man/RTRIM.Rd @@ -0,0 +1,46 @@ +\name{RTRIM} +\alias{RTRIM} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper Function RTRIM +} +\description{ +Makes a wrapper around the fastpath function RTRIM +} +\usage{ +RTRIM(x) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +a teradata dataframe that contains column(s) of characters whose padding to their right will be trimmed +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A teradata data frame of the columns that will be trimmed at the end of each character +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Todd Brye, Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +tdf["col2"] <- RTRIM(tdf["col1"]) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/on.Rd b/man/on.Rd new file mode 100644 index 0000000..6065246 --- /dev/null +++ b/man/on.Rd @@ -0,0 +1,73 @@ +\name{on} +\alias{on} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +On Function +} +\description{ +Creates A representation of an ON Clause in an ExecR Table Operator query. +} +\usage{ +on(target=NULL, from=NULL, subQuery=NULL, partition=NULL, hash=NULL, order=NULL, local_order=NULL, null_order=NULL, dimension=NULL, as=NULL) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ +\item{target}{ +a character that represents a name of a table or a query expression +} +\item{from}{ +a character that represents a name of the origin of a query expression +} +\item{subQuery}{ +a character that represents a nested ON Clause or nested query expression that is part of an ON Clause +} +\item{partition}{ +the parallel option, partition by , or partition by +} +\item{hash}{ +the parallel option, hash by +} +\item{order}{ +the parallel option, order by +} +\item{local_order}{ +the parallel option, local order by +} +\item{null_order}{ +specification for the parallel option local_order +} +\item{dimension}{ +the parallel option, dimension +} +\item{as}{ +creates and alias +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +a string representation of an ON Clause for a table operator +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +o <- on(target="select *" from="tab1", partition="any") +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/td.CalcMatrix.Rd b/man/td.CalcMatrix.Rd new file mode 100644 index 0000000..ba98517 --- /dev/null +++ b/man/td.CalcMatrix.Rd @@ -0,0 +1,70 @@ +\name{td.CalcMatrix} +\alias{td.CalcMatrix} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +Wrapper function for CalcMatrix +} +\description{ +Creates A wrapper around the CalcMatrix table operator, using R Code. +} +\usage{ +td.CalcMatrix(selectPhrase=string, ons=string, phase=NULL, calctype=NULL, output=NULL, null_handling=NULL, optional_operators=NULL, as=NULL) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ +\item{selectPhrase}{ + a character that represents the select clause for a query expression +} +\item{ons}{ +a character or list representation of the needed ON Clauses +} +\item{phase}{ +the character representation of the input of the optional PHASE clause +} +\item{calctype}{ +the character representation of the input of the optional CALCTYPE clause +} +\item{output}{ +the character representation of the input of the optional OUTPUT clause +} +\item{null_handling}{ +the character representation of the input of the optional specfication for null handling +} +\item{optional_operators}{ +the character representation of the other operators that can be specified +} +\item{as}{ +creates and alias +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +a character representation of a query that can be passed into TdQuery to use the CalcMatrix table operator. +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +on2 <- on(target= "select * from tab1") +query <- td.CalcMatrix(selectPhrase="select session as ampkey, D1.* from TD_SYSFNLIB.calcmatrix", ons=on1, phase="LOCAL", as="D1") +res <- tdQuery(query) +print(res) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/td.ExecR.Rd b/man/td.ExecR.Rd new file mode 100644 index 0000000..06a3138 --- /dev/null +++ b/man/td.ExecR.Rd @@ -0,0 +1,64 @@ +\name{td.ExecR} +\alias{td.ExecR} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ +ExecR Wrapper Function +} +\description{ +This function is a wrapper function around the table operator ExecR. It generates a string that can be passed into the function tdQuery to make a query that uses ExecR. The Contract and Operator can be given as character vectors or read from files. In the latter case, the path to the file is given for Contract or Operator. The file(s) must include only R code, the contents of the files essentially get copied. Files paths can be specified by using relative paths from getwd() or the absolute path. +} +\usage{ +td.ExecR(selectPhrase=string, ons=list(), returns=NULL, contract=NULL, operator=string, optional_operators=NULL) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{selectPhrase}{ +a character that represents a select phrase +} + \item{ons}{ +a list or character representation of on clauses +} + \item{returns}{ +a character vector of a returns clause (e.g. returns <- c("col1 int", "col2 real")) +} + \item{contract}{ +a file or character representation of a contract clause. +} + \item{operator}{ +a file or character representation of an operator clause +} + \item{optional_operators}{ +a character representation of any other needed operators +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +A character representation of a query that will use the ExecR table operator when passed into the tdQuery function. +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Erin Cole +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +\code{\link{on}} +} +\examples{ +on1 <- on(target="select *", from="tab1", hash="c1", local_order="c2") +query <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=on1, contract="~/Documents/contract.txt", operator="~/Documents/operator.txt") +res <- tdQuery(query) +print(res) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/test/.DS_Store b/test/.DS_Store new file mode 100644 index 0000000..abba6a8 Binary files /dev/null and b/test/.DS_Store differ diff --git a/test/basicContract.txt b/test/basicContract.txt new file mode 100755 index 0000000..3fd0f1c --- /dev/null +++ b/test/basicContract.txt @@ -0,0 +1 @@ +library(tdr); \ No newline at end of file diff --git a/test/basicOperator.txt b/test/basicOperator.txt new file mode 100755 index 0000000..3fd0f1c --- /dev/null +++ b/test/basicOperator.txt @@ -0,0 +1 @@ +library(tdr); \ No newline at end of file diff --git a/test/setup.R b/test/setup.R new file mode 100644 index 0000000..a29e594 --- /dev/null +++ b/test/setup.R @@ -0,0 +1,106 @@ +# Although this file is an R file, for the sake of consistency with the other +# files, the code is in SQL. It is all commented out so that the file does not +# produce compile errors. Please copy and past the desired code into bteq in +# order to make the needed tables + +# Table Name: numTab +# This table is used for testing numeric functions. It works with the tests for +# AVG(), DECODE(), POWER(), and TO_CHAR(). +# +# drop table numTab; +# drop table numTab2; +# create table numTab ( +# c1 integer, +# c2 integer, +# c3 character(1)); +# +# insert into numTab (c1, c2, c3) values (5, 2, '9'); +# insert into numTab (c1, c2, c3) values (8, 3, '9'); +# insert into numTab (c1, c2, c3) values (2, 4, '9'); +# insert into numTab (c1, c2, c3) values (6, 3, '9'); +# insert into numTab (c1, c2, c3) values (3, 2, '9'); +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Table Name: negNums +# This table is used for testing the SIGN() function +# +# drop table negNums; +# drop table negNums2; +# create table negNums ( +# c1 integer); +# +# insert into negNums values(-11); +# insert into negNums values(3); +# insert into negNums values(-2); +# insert into negNums values(4); +# insert into negNums values(555); +# insert into negNums values(0); +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Table Name: test +# This table is used for testing functions for character manipulation. It +# works with the tests for CHR(), INITCAP(), and NGRAM(). +# +# drop table test; +# drop table test2; +# create table test ( +# c1 integer, +# c2 varchar(100), +# c3 varchar(100)); +# +# insert into test (c1, c2, c3) values (1, 'mouse', 'house'); +# insert into test (c1, c2, c3) values (2, 'fork', 'spoon'); +# insert into test (c1, c2, c3) values (3, 'ball', 'bat'); +# insert into test (c1, c2, c3) values (4, 'robot', 'human'); +# insert into test (c1, c2, c3) values (5, 'cat', 'dog'); +# insert into test (c1, c2, c3) values (6, 'horse', 'force'); + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Table Name: charTab +# This table is used for testing functions that search characters under +# certain conditions. It works with tests for INSTR(), OREPLACE(), OTRANSLATE(). +# +# drop table charTab; +# drop table charTab2; +# create table charTab ( +# c1 varchar(50), +# c2 varchar(50), +# c3 varchar(50), +# c4 varchar(50), +# c5 varchar(50)); +# +# insert into charTab (c1, c2, c3, c4, c5) values ('explore', 'lo', 'xx', 'e', 'z'); +# insert into charTab (c1, c2, c3, c4, c5) values ('interrupt', 'ter', 'xyz', 'u', 'z'); +# insert into charTab (c1, c2, c3, c4, c5) values ('disappear', 'ar', 'yy', 's', 'z'); +# insert into charTab (c1, c2, c3, c4, c5) values ('factor', 'ac', 'xy', 'c', 'z'); +# insert into charTab (c1, c2, c3, c4, c5) values ('appreciate', 'pp', 'xx', 'r', 'z'); +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Table Name: padTab +# This table is used for testing functions that manipulate white space. It +# works with tests for LPAD(), LTRIM(), RPAD(), and RTRIM(). +# +# drop table padTab; +# drop table padTab2; +# create table padTab ( +# c1 varchar(10), +# c2 varchar(10), +# c3 varchar(10)); +# +# insert into padTab (c1, c2, c3) values ('Emily ',' Emily', 'Emily'); +# insert into padTab (c1, c2, c3) values ('Daisy ', ' Daisy', 'Daisy'); +# insert into padTab (c1, c2, c3) values ('Hank ', ' Hank', 'Hank'); +# insert into padTab (c1, c2, c3) values ('Amy ', ' Amy', 'Amy'); +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Table Name: numManip +# This table is used for testing functions that manupulate numbers. It works +# with tests for TO_NUMBER() and TRUNC(). +# +# +# drop table numManip; +# drop table numManip2; +# create table numManip ( +# c1 character(5), +# c2 number); +# +# insert into numManip (c1, c2) values ('1', 555.3); +# insert into numManip (c1, c2) values ('2', 8.289); +# insert into numManip (c1, c2) values ('3', 48.1); +# insert into numManip (c1, c2) values ('4', 17.06); +# insert into numManip (c1, c2) values ('5', 13.99); \ No newline at end of file diff --git a/test/testCHR.R b/test/testCHR.R new file mode 100644 index 0000000..7e2a445 --- /dev/null +++ b/test/testCHR.R @@ -0,0 +1,25 @@ +# Below is the table used for the test, called "test" +# c1 c2 c3 +# ---------- ----------- ---------- +# 5 cat dog +# 4 robot human +# 6 horse force +# 3 ball bat +# 1 mouse house +# 2 fork spoon +tdf <- td.data.frame("test") +tdf["c4"] <- CHR(tdf["c1"]) +as.td.data.frame(tdf, tableName="test2") + +# the resulting table is below, called "test2" +# c1 c2 c3 c4 +# ---------- ----------- ---------- --------- +# 5 cat dog +# 4 robot human +# 6 horse force +# 3 ball bat +# 1 mouse house +# 2 fork spoon + +#Although the resulting table does not seem to give the expected output, the same output occurs in bteq and in RStudio. +#Further testing is recommended \ No newline at end of file diff --git a/test/testCalcMatrix.R b/test/testCalcMatrix.R new file mode 100755 index 0000000..465deea --- /dev/null +++ b/test/testCalcMatrix.R @@ -0,0 +1,66 @@ +#on1 <- on(target="select var1, var2, var3, var4, var5", from="testCM") +#res1 <- td.CalcMatrix(selectPhrase='select * from TD_SYSFNLIB.calcmatrix', ons=on1, phase="local", as= "D1") +#query1 <- tdQuery(res1) +#print(query1) + +#on2 <- on(target= "select * from numbers") +#res2 <- td.CalcMatrix(selectPhrase="select session as ampkey, D1.* from TD_SYSFNLIB.calcmatrix", ons=on2, phase="LOCAL", as="D1") +#query2 <- tdQuery(res2) +#print(query2) + +#on3 <- on(target="select var1, var2, var3, var4, var5 from TestCM2") +#res4 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on3, phase="local", as="D1") +#query4 <- tdQuery(res4) +#print(query4) + +#on4 <- on(target ="select * from TestCMLocal", hash="p") +#res5 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on4, phase="combine", calctype="sscp", output="columns", as="D1") +#query5 <- tdQuery(res5) +#print(query5) + +#on5 <- on(target ="select * from TestCMLocal", hash="p") +#res6 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on5, phase="combine", calctype="CSSCP", output="columns", as="D1") +#query6 <- tdQuery(res6) +#print(query6) + +#on6 <-on(target="select * from TestCMLocal", hash="p") +#res7 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on6, phase="combine", calctype="COV", output="columns", as="D1") +#query7 <- tdQuery(res7) +#print(query7) + +#on7 <- on(target="select * from TestCMLocal", hash="p") +#res8 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on7, phase="combine", calctype="COR", output="varbyte", as="D1") +#query8 <- tdQuery(res8) +#print(query8) + +#on8 <- on(target="select * from TestCMLocal", hash="p") +#res9 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on8, phase="combine", calctype="SSCP", output="varbyte", as="D1") +#query9 <- tdQuery(res9) +#print(query9) + +#on9 <- on(target="select var1, var2, var3, var4, var5 from TestCMNull") +#res10 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on9, phase="local", null_handling="ignore", as="D1") +#query10 <- tdQuery(res10) +#print(query10) + +#on10 <- on(target="select var1, var2, var3, var4, var5", from="TestCMNull") +#res11 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on10, phase="local", null_handling="zero", as="D1") +#query11 <- tdQuery(res11) +#print(query11) + +#on11 <- on(target="select p, var1, var2, var3, var4, var5 from TestCM_Mult", local_order="p") +#res12 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on11, phase="local", as="D1") +#query12 <- tdQuery(res12) +#print(query12) + +#on12 <- on(target="select p, var1, var2, var3, var4, var5 from TestCM_Mult", local_order="p") +#res13 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on12, phase="local", as="D1") +#query13 <- tdQuery(res13) +#print(query13) + +#on14 <- on(target="select p, var1, var2, var3, var4,var5", from="TESTCM_Mult", local_order = "p") +#sub1 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on14, phase="local", as="D1") +#on15 <- on(target=sub1, hash="p", local_order="p") +#res14 <- td.CalcMatrix(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on15, phase="combine", calctype="esscp", as="D2") +#query14 <- tdQuery(res14) +#print(query14) diff --git a/test/testDECODE.R b/test/testDECODE.R new file mode 100644 index 0000000..ecca1f6 --- /dev/null +++ b/test/testDECODE.R @@ -0,0 +1,38 @@ +# Below is the table used for the test, called "numTab" +# +# c1 c2 c3 +# ----------- ----------- -- +# 5 2 9 +# 6 3 9 +# 3 2 9 +# 8 3 9 +# 2 4 9 + +tdf <- td.data.frame("numTab") +tdf["c4"] <- DECODE(tdf["c1"], default='none', 1, 'Alpha', 2, 'Bravo', 3, 'Charlie', 4, 'Delta', 5, 'Echo') +as.td.data.frame(tdf, tableName="numTab2") + +# This is the resulting table, called "numTab2" +# c1 c2 c3 c4 +# ----------- ----------- -- ------- +# 5 2 9 Echo +# 6 3 9 none +# 3 2 9 Charlie +# 8 3 9 none +# 2 4 9 Bravo + +# To verify each entry of c4: +res1 = tdQuery("select c4 from numTab2 where c1=5") == "Echo" +stopifnot(res1) + +res2 = tdQuery("select c4 from numTab2 where c1=6") == "none" +stopifnot(res2) + +res3 = tdQuery("select c4 from numTab2 where c1=3") == "Charlie" +stopifnot(res3) + +res4 = tdQuery("select c4 from numTab2 where c1=8") == "none" +stopifnot(res4) + +res5 = tdQuery("select c4 from numTab2 where c1=2") == "Bravo" +stopifnot(res5) \ No newline at end of file diff --git a/test/testExecR.R b/test/testExecR.R new file mode 100755 index 0000000..ffedda6 --- /dev/null +++ b/test/testExecR.R @@ -0,0 +1,75 @@ +source("~/Documents/RRR/Code/ExecR.R") + +#on1 <- on(target= "select * from test", hash="c1", local_order="c2") +#onList <- list(on1) +#res1 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=onList, contract="~/Documents/RRR/contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query1 <- tdQuery(res1) +#print(query1) + +#on2 <- on(target="test", dimension="") +#onList2 <-list( on3) +#print(onList2) +#res2 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=onList2, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query2 <- tdQuery(res2) +#print(query2) + +#on4 <- on(target="numbers", partition="1") +#on5 <- on(target="numbers", dimension="") +#onList3 <- list(on4, on5) +#res3 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=onList3, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators=NULL) +#query3 <- tdQuery(res3) +#print(query3) + +#on6 <- on(target="select 1", partition="1") +#on7 <- on(target="select * from test", dimension = "") +#onList4 <- list(on6, on7) +#res4 <- td.ExecR(selectPhrase = "select * from TD_SYSGPL.ExecR", ons=onList4, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators = "keeolog(1)\nlogdebug(1)") +#query4 <- tdQuery(res4) +#print(query4) + +#on8 <- on(target="select * from test", as="test") +#res5 <- td.ExecR(selectPhrase = "select * from TD_SYSGPL.ExecR", ons=on8, contract= "~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query5 <- tdQuery(res5) +#print(query5) + +#on9 <- on(target="test", as="test1", partition="c1") +#on10 <- on(target ="test", as="test2", dimension="") +#onList5 <- list(on9, on10) +#res6 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=onList5, contract= "~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query6 <- tdQuery(res6) +#print(query6) + +#on11 <- on(target="test", as="test1", partition="c1") +#on12 <- on(target="test", as="test2", dimension=" ") +#on13 <- on(target="test", as="test3", dimension=" ") +#onList6 <- list(on11, on12, on13) +#res7 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=onList6, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators = "keeplog(1)\nlogdebug(1)") +#query7 <- tdQuery(res7) +#print(query7) + +#on14 <- on(target="select *", from ="test", hash="c1", local_order="c1") +#res8 <- td.ExecR(selectPhrase="select distinct * from TD_SYSGPL.ExecR", ons=on14, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt") +#query8 <- tdQuery(res8) +#print(query8) + +#on15 <- on(target= "select * from test", partition="c1") +#res9 <- td.ExecR(selectPhrase="select * from TD_SYSGPL.ExecR", ons=on15, contract="~/Documents/RRR/Contract.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query9 <- tdQuery(res9) +#print(query9) + +#on16 <- on(target="twm_customer_analysis", partition="marital_status") +#res10 <- td.ExecR(selectPhrase="select * from TD_SYSGPL.ExecR", ons=on16, returns="~/Documents/RRR/returns.txt", operator="~/Documents/RRR/Test/basicOperator.txt", optional_operators="keeplog(1)\nlogdebug(1)") +#query10 <- tdQuery(res10) +#print(query10) + +#test case does not work +#on17 <- on(target="select * from test") +#res11 <- td.ExecR(selectPhrase="select * from TD_SYSGPL.ExecR", ons=on17, returns="testout", operator="~/Documents/RRR/Test/basicOperator.txt") +#query11 <- tdQuery(res11) +#print(query11) + +#test case missing contract clause. Should get an error +#on18 <- on(target="select *", from="test") +#res12 <- td.ExecR(selectPhrase="select * from TD_SYSGPL.ExecR", ons=on18, operator="~/Documents/RRR/Test/basicOperator.txt") +#query12 <- tdQuery(res12) +#print(query12) \ No newline at end of file diff --git a/test/testINITCAP.R b/test/testINITCAP.R new file mode 100644 index 0000000..4560285 --- /dev/null +++ b/test/testINITCAP.R @@ -0,0 +1,42 @@ +# Below is the table used for the test, called "test" +# c1 c2 c3 +# ---------- ----------- ---------- +# 5 cat dog +# 4 robot human +# 6 horse force +# 3 ball bat +# 1 mouse house +# 2 fork spoon +# the R code is below: +tdf <- td.data.frame("test") +tdf["c4"] <- INITCAP(tdf["c2"]) +as.td.data.frame(tdf, tableName="test2") + +# Below are the results of the table, when you type "select * from test2" +# c1 c2 c3 c4 +# ---------- ----------- ---------- --------- +# 5 cat dog Cat +# 4 robot human Robot +# 6 horse force Horse +# 3 ball bat Ball +# 1 mouse house Mouse +# 2 fork spoon Fork +# +# To verify each entry of test2 +res1 = tdQuery("select c4 from test2 where c1=5") == "Cat" +stopifnot(res1) + +res2 = tdQuery("select c4 from test2 where c1=4") == "Robot" +stopifnot(res2) + +res3 = tdQuery("select c4 from test2 where c1=6") == "Horse" +stopifnot(res3) + +res4 = tdQuery("select c4 from test2 where c1=3") == "Ball" +stopifnot(res4) + +res5 = tdQuery("select c4 from test2 where c1=1") == "Mouse" +stopifnot(res5) + +res6 = tdQuery("select c4 from test2 where c1=2") == "Fork" +stopifnot(res6) \ No newline at end of file diff --git a/test/testINSTR.R b/test/testINSTR.R new file mode 100644 index 0000000..acc23e5 --- /dev/null +++ b/test/testINSTR.R @@ -0,0 +1,24 @@ +# Below is the table used for the test, called "charTab" +# c1 c2 c3 c4 c5 +# ---------- ---- ------- --------- --------- +# explore lo xx e z +# interrupt ter xyz u z +# disappear ar yy s z +# factor ac xy c z +# appreciate pp xx r z + +tdf <- td.data.frame("charTab") +tdf["c6"] <- INSTR(tdf["c1"], tdf["c2"]) +as.td.data.frame(tdf, tableName="charTab2") + +# This is the resulting table, called "charTab2" +# c1 c2 c3 c4 c5 c6 +# ---------- ---- ------- --------- --------- --------- +# explore lo xx e z 4 +# interrupt ter xyz u z 3 +# disappear ar yy s z 8 +# factor ac xy c z 2 +# appreciate pp xx r z 2 + +# While running the equivalent code in bteq produces the same table, this test does not seem to give the expected output +# I recommend further testing. \ No newline at end of file diff --git a/test/testLPAD.R b/test/testLPAD.R new file mode 100644 index 0000000..b8feb86 --- /dev/null +++ b/test/testLPAD.R @@ -0,0 +1,33 @@ +# Below is the table used for the test, called "padTab" +# c1 c2 c3 +# --------------- --------------- --------------- +# Emily Emily Emily +# Daisy Daisy Daisy +# Hank Hank Hank +# Amy Amy Amy +# +# the R code is below: +tdf <- td.data.frame("padTab") +tdf["c4"] <- LPAD(tdf["c3"], 15, "x") +as.td.data.frame(tdf, tableName="padTab2") + +# Below are the results of the table, when you type "select * from padTab2" +# c1 c2 c3 c4 +# --------------- --------------- --------------- --------------------------- +# Emily Emily Emily xxxxxxxxxxEmily +# Daisy Daisy Daisy xxxxxxxxxxDaisy +# Hank Hank Hank xxxxxxxxxxxHank +# Amy Amy Amy xxxxxxxxxxxxAmy + +# To verify each entry of c4: +res1 = tdQuery("select c4 from padTab2 where c3='Emily'") == "xxxxxxxxxxEmily" +stopifnot(res1) + +res2 = tdQuery("select c4 from padTab2 where c3='Daisy'") == "xxxxxxxxxxDaisy" +stopifnot(res2) + +res3 = tdQuery("select c4 from padTab2 where c3='Hank'") == "xxxxxxxxxxxHank" +stopifnot(res3) + +res4 = tdQuery("select c4 from padTab2 where c3='Amy'") == "xxxxxxxxxxxxAmy" +stopifnot(res4) \ No newline at end of file diff --git a/test/testLTRIM.R b/test/testLTRIM.R new file mode 100644 index 0000000..c680571 --- /dev/null +++ b/test/testLTRIM.R @@ -0,0 +1,31 @@ +# Below is the table used for the test, called "padTab" +# c1 c2 c3 +# --------------- --------------- --------------- +# Emily Emily Emily +# Daisy Daisy Daisy +# Hank Hank Hank +# Amy Amy Amy + +tdf <- td.data.frame("padTab") +tdf["c4"] <- LTRIM(tdf["c2"]) +as.td.data.frame(tdf, tableName="padTab2") + +#this is the resulting table caled "padTab2" +# c1 c2 c3 c4 +# ---------- ---------- ---------- ---------- +# Emily Emily Emily Emily +# Daisy Daisy Daisy Daisy +# Hank Hank Hank Hank +# Amy Amy Amy Amy + +res1 = tdQuery("select c4 from padTab2 where c3='Emily'") == "Emily" +stopifnot(res1) + +res2 = tdQuery("select c4 from padTab2 where c3='Daisy'") == "Daisy" +stopifnot(res2) + +res3 = tdQuery("select c4 from padTab2 where c3='Hank'") == "Hank" +stopifnot(res3) + +res4 = tdQuery("select c4 from padTab2 where c3='Amy'") == "Amy" +stopifnot(res4) \ No newline at end of file diff --git a/test/testNGRAM.R b/test/testNGRAM.R new file mode 100644 index 0000000..da911ae --- /dev/null +++ b/test/testNGRAM.R @@ -0,0 +1,41 @@ +# Below is the table used for the test, called "test" +# c1 c2 c3 +# ---------- ----------- ---------- +# 5 cat dog +# 4 robot human +# 6 horse force +# 3 ball bat +# 1 mouse house +# 2 fork spoon + +tdf <- td.data.frame("test") +tdf["c4"] <- NGRAM(tdf["c2"], tdf["c3"], 2) +as.td.data.frame(tdf, tableName="test2") + +#this is the resulting table, called "test2" +# c1 c2 c3 c4 +# ---------- ----------- ---------- --------- +# 5 cat dog 0 +# 4 robot human 0 +# 6 horse force 1 +# 3 ball bat 1 +# 1 mouse house 3 +# 2 fork spoon 0 +# +res1 = tdQuery("select c4 from test2 where c1=5") == 0 +stopifnot(res1) + +res2 = tdQuery("select c4 from test2 where c1=4") == 0 +stopifnot(res2) + +res3 = tdQuery("select c4 from test2 where c1=6") == 1 +stopifnot(res3) + +res4 = tdQuery("select c4 from test2 where c1=3") == 1 +stopifnot(res4) + +res5 = tdQuery("select c4 from test2 where c1=1") == 3 +stopifnot(res5) + +res6 = tdQuery("select c4 from test2 where c1=2") == 0 +stopifnot(res6) \ No newline at end of file diff --git a/test/testOREPLACE.R b/test/testOREPLACE.R new file mode 100644 index 0000000..3b20a50 --- /dev/null +++ b/test/testOREPLACE.R @@ -0,0 +1,37 @@ +# Below is the table used for the test, called "charTab" +# c1 c2 c3 c4 c5 +# ---------- ---- ------- --------- --------- +# explore lo xx e z +# interrupt ter xyz u z +# disappear ar yy s z +# factor ac xy c z +# appreciate pp xx r z + +tdf <- td.data.frame("charTab") +tdf["c6"] <- OREPLACE(tdf["c1"], tdf["c2"], tdf["c3"]) +as.td.data.frame(tdf, tableName="charTab2") + +#this is the resulting table, charTab2 +# c1 c2 c3 c4 c5 c6 +# ---------- ---- ------- --------- --------- ---------- +# explore lo xx e z expxxre +# interrupt ter xyz u z inxyzrupt +# disappear ar yy s z disappeyy +# factor ac xy c z fxytor +# appreciate pp xx r z axxreciate +# +# To verify each entry of c6: +res1 = tdQuery("select c6 from charTab2 where c1='explore'") == "expxxre" +stopifnot(res1) + +res2 = tdQuery("select c6 from charTab2 where c1='interrupt'") == "inxyzrupt" +stopifnot(res2) + +res3 = tdQuery("select c6 from charTab2 where c1='disappear'") == "disappeyy" +stopifnot(res3) + +res4 = tdQuery("select c6 from charTab2 where c1='factor'") == "fxytor" +stopifnot(res4) + +res5 = tdQuery("select c6 from charTab2 where c1='appreciate'") == "axxreciate" +stopifnot(res5) \ No newline at end of file diff --git a/test/testOTRANSLATE.R b/test/testOTRANSLATE.R new file mode 100644 index 0000000..0a98f2a --- /dev/null +++ b/test/testOTRANSLATE.R @@ -0,0 +1,38 @@ +# Below is the table used for the test, called "charTab" +# c1 c2 c3 c4 c5 +# ---------- ---- ------- --------- --------- +# explore lo xx e z +# interrupt ter xyz u z +# disappear ar yy s z +# factor ac xy c z +# appreciate pp xx r z + +tdf <- td.data.frame("charTab") +tdf["c6"] <- OTRANSLATE(tdf["c1"], tdf["c4"], tdf["c5"]) +as.td.data.frame(tdf, tableName="charTab2") + +#this is the resulting table, charTab2 +# +# c1 c2 c3 c4 c5 c6 +# ---------- ---- ------- --------- --------- ---------- +# explore lo xx e z zxplorz +# interrupt ter xyz u z interrzpt +# disappear ar yy s z dizappear +# factor ac xy c z faztor +# appreciate pp xx r z appzeciate + +# To verify each entry of c6: +res1 = tdQuery("select c6 from charTab2 where c1='explore'") == "zxplorz" +stopifnot(res1) + +res2 = tdQuery("select c6 from charTab2 where c1='interrupt'") == "interrzpt" +stopifnot(res2) + +res3 = tdQuery("select c6 from charTab2 where c1='disappear'") == "dizappear" +stopifnot(res3) + +res4 = tdQuery("select c6 from charTab2 where c1='factor'") == "faztor" +stopifnot(res4) + +res5 = tdQuery("select c6 from charTab2 where c1='appreciate'") == "appzeciate" +stopifnot(res5) \ No newline at end of file diff --git a/test/testOn.R b/test/testOn.R new file mode 100644 index 0000000..006cc43 --- /dev/null +++ b/test/testOn.R @@ -0,0 +1,31 @@ +#test On() +#res1 = on(target="select *", from="tab1", partition = "any", hash = "col1") == "on (select * from tab1)\npartition by any\nhash by col1" +#print(res1) +#stopifnot(res1) + +#res2 = on(target="select *", from="tab1", hash="col1", local_order="col2") == "on (select * from tab1)\nhash by col1\nlocal order by col2" +#stopifnot(res2) + +#res3 = on(target="tab1", partition="col1") == "on tab1\npartition by col1" +#print(res3) +#stopifnot(res3) + +#res4 = on(target="tab1", dimension= " ") == "on tab1\ndimension" +#stopifnot(res4) + +#res5 = on(target="select 1", partition="1") == "on (select 1)\npartition by 1" +#print(res5) +#stopifnot(res5) + +#res6 = on(target="select *", from="tab1", hash="col1", local_order="col1, col2") == "on (select * from tab1)\nhash by col1\nlocal order by col1, col2" +#print(res6) +#stopifnot(res6) + +#res7 = on(target="select *", from="tab1", as="test") == "on (select * from tab1)\nas test" +#print(res7) +#stopifnot(res7) + +#on1 = on(target="select p, var1, var2, var3, var4, var5", from="TestCM_Mult", local_order="p") +#littleOnClause= toQuery(selectPhrase="select * from TD_SYSFNLIB.calcmatrix", ons=on1, phase="local", as="D1") +#ons2 = on(target="select *", from="TD_SYSFNLIB.calcmatrix", subQuery=on1, hash="p", local_order="p") +#print(ons2) \ No newline at end of file diff --git a/test/testPOWER.R b/test/testPOWER.R new file mode 100644 index 0000000..0f73292 --- /dev/null +++ b/test/testPOWER.R @@ -0,0 +1,38 @@ +# Below is the table used for the test, called "numTab" +# +# c1 c2 c3 +# ----------- ----------- -- +# 5 2 9 +# 6 3 9 +# 3 2 9 +# 8 3 9 +# 2 4 9 + +tdf <- td.data.frame("numTab") +tdf['c4'] <- POWER(tdf['c1'], tdf['c2']) +as.td.data.frame(tdf, tableName="numTab2") + +# this is the resulting table, called "numTab2" +# c1 c2 c3 c4 +# ----------- ----------- -- ---------------------------------------- +# 5 2 9 25 +# 6 3 9 216 +# 3 2 9 9 +# 8 3 9 512 +# 2 4 9 16 + +# To verify each entry of c4: +res1 = tdQuery("select c4 from numTab2 where c1=5") == 25 +stopifnot(res1) + +res2 = tdQuery("select c4 from numTab2 where c1=6") == 216 +stopifnot(res2) + +res3 = tdQuery("select c4 from numTab2 where c1=3") == 9 +stopifnot(res3) + +res4 = tdQuery("select c4 from numTab2 where c1=8") == 512 +stopifnot(res4) + +res5 = tdQuery("select c4 from numTab2 where c1=2") == 16 +stopifnot(res5) \ No newline at end of file diff --git a/test/testRPAD.R b/test/testRPAD.R new file mode 100644 index 0000000..8761d80 --- /dev/null +++ b/test/testRPAD.R @@ -0,0 +1,33 @@ +# Below is the table used for the test, called "padTab" +# c1 c2 c3 +# --------------- --------------- --------------- +# Emily Emily Emily +# Daisy Daisy Daisy +# Hank Hank Hank +# Amy Amy Amy +# +# the R code is below: +tdf <- td.data.frame("padTab") +tdf["c4"] <- RPAD(tdf["c3"], 15, "x") +as.td.data.frame(tdf, tableName="padTab2") + +# Below are the results of the table, when you type "select * from padTab2" +# into bteq +# c1 c2 c3 c4 +# ---------- ---------- ---------- ------------------------------------------ +# Emily Emily Emily Emilyxxxxxxxxxx +# Daisy Daisy Daisy Daisyxxxxxxxxxx +# Hank Hank Hank Hankxxxxxxxxxxx +# Amy Amy Amy Amyxxxxxxxxxxxx +# +res1 = tdQuery("select c4 from padTab2 where c3='Emily'") == "Emilyxxxxxxxxxx" +stopifnot(res1) + +res2 = tdQuery("select c4 from padTab2 where c3='Daisy'") == "Daisyxxxxxxxxxx" +stopifnot(res2) + +res3 = tdQuery("select c4 from padTab2 where c3='Hank'") == "Hankxxxxxxxxxxx" +stopifnot(res3) + +res4 = tdQuery("select c4 from padTab2 where c3='Amy'") == "Amyxxxxxxxxxxxx" +stopifnot(res4) \ No newline at end of file diff --git a/test/testRTRIM.R b/test/testRTRIM.R new file mode 100644 index 0000000..793c5a1 --- /dev/null +++ b/test/testRTRIM.R @@ -0,0 +1,28 @@ +# Below is the table used for the test, called "padTab" +# c1 c2 c3 +# --------------- --------------- --------------- +# Emily Emily Emily +# Daisy Daisy Daisy +# Hank Hank Hank +# Amy Amy Amy + +tdf <- td.data.frame("padTab") +tdf["c4"] <- RTRIM(tdf["c1"]) +as.td.data.frame(tdf, tableName="padTab2") +# c1 c2 c3 c4 +# ---------- ---------- ---------- ---------- +# Emily Emily Emily Emily +# Daisy Daisy Daisy Daisy +# Hank Hank Hank Hank +# Amy Amy Amy Amy +res1 = tdQuery("select c4 from padTab2 where c3='Emily'") == "Emily" +stopifnot(res1) + +res2 = tdQuery("select c4 from padTab2 where c3='Daisy'") == "Daisy" +stopifnot(res2) + +res3 = tdQuery("select c4 from padTab2 where c3='Hank'") == "Hank" +stopifnot(res3) + +res4 = tdQuery("select c4 from padTab2 where c3='Amy'") == "Amy" +stopifnot(res4) \ No newline at end of file diff --git a/test/testSIGN.R b/test/testSIGN.R new file mode 100644 index 0000000..3a8b9e0 --- /dev/null +++ b/test/testSIGN.R @@ -0,0 +1,43 @@ +# Below is the table used for the test, called "negNums" +# +# c1 +# ----------- +# 3 +# -11 +# 0 +# 4 +# -2 +# 555 + +tdf <- td.data.frame("negNums") +tdf["c2"] <- SIGN(tdf["c1"]) +as.td.data.frame(tdf, tableName="negNums2") + +#this is the resulting table, called "negNums2" +# c1 c2 +# ----------- ---------------------------------------- +# 3 1 +# -11 -1 +# 0 0 +# 4 1 +# -2 -1 +# 555 1 + +# To verify each entry of c2: +res1 = tdQuery("select c2 from negNums2 where c1=3") ==1 +stopifnot(res1) + +res2 = tdQuery("select c2 from negNums2 where c1=-11") == -1 +stopifnot(res2) + +res3 = tdQuery("select c2 from negNums2 where c1=0") == 0 +stopifnot(res3) + +res4 = tdQuery("select c2 from negNums2 where c1=4") == 1 +stopifnot(res4) + +res5 = tdQuery("select c2 from negNums2 where c1=-2") == -1 +stopifnot(res5) + +res6 = tdQuery("select c2 from negNums2 where c1=555") == 1 +stopifnot(res6) \ No newline at end of file diff --git a/test/testTO_CHAR.R b/test/testTO_CHAR.R new file mode 100644 index 0000000..89af1e3 --- /dev/null +++ b/test/testTO_CHAR.R @@ -0,0 +1,40 @@ +# Below is the table used for the test, called "numTab" +# c1 c2 c3 +# ----------- ----------- -- +# 5 2 9 +# 6 3 9 +# 3 2 9 +# 8 3 9 +# 2 4 9 + +tdf <- td.data.frame("numTab") +tdf["c4"] <- TO_CHAR(tdf["c1"], tdf["c3"]) +as.td.data.frame(tdf, tableName="numTab2") + +# this is the resulting table, called "numTab2" Although the values look +# unchanged, the type of 'c4' is a varchar, while the type of 'c1' is an +# integer. This can be verified by typing "show table numTab2" into bteq or +# "tdQuery("show table numTab2")" into RStudio. +# c1 c2 c3 c4 +# ----------- ----------- -- ------------------------------------------------ +# 5 2 9 5 +# 6 3 9 6 +# 3 2 9 3 +# 8 3 9 8 +# 2 4 9 2 + +# To verify each entry of c4: +res1 = tdQuery("select c4 from numTab2 where c1=5") == '5' +stopifnot(res1) + +res2 = tdQuery("select c4 from numTab2 where c1=6") == '6' +stopifnot(res2) + +res3 = tdQuery("select c4 from numTab2 where c1=3") == '3' +stopifnot(res3) + +res4 = tdQuery("select c4 from numTab2 where c1=8") == '8' +stopifnot(res4) + +res5 = tdQuery("select c4 from numTab2 where c1=2") == '2' +stopifnot(res5) \ No newline at end of file diff --git a/test/testTO_NUMBER.R b/test/testTO_NUMBER.R new file mode 100644 index 0000000..6c12cf9 --- /dev/null +++ b/test/testTO_NUMBER.R @@ -0,0 +1,50 @@ +# Below is the table used for the test, called "numManip" +# c1 c2 +# ----- ---------------------------------------- +# 2 8.289 +# 5 13.99 +# 4 17.06 +# 3 48.1 +# 1 555.3 +# +# the R code is below: +tdf <- td.data.frame("numManip") +tdf["c3"] <- TO_NUMBER(tdf['c1']) +as.td.data.frame(tdf, tableName="numManip2") +# +# Below are the results of the table, when you type "select * from numManip2" +# c1 c2 c3 +# ----- ---------------------------------------- ---------------------------- +# 2 8.289 2 +# 5 13.99 5 +# 4 17.06 4 +# 3 48.1 3 +# 1 555.3 1 +# +# To verify the data type of c3, type 'show table numManip2' into bteq: +# CREATE SET TABLE ECOLE.numManip2 ,NO FALLBACK , +# NO BEFORE JOURNAL, +# NO AFTER JOURNAL, +# CHECKSUM = DEFAULT, +# DEFAULT MERGEBLOCKRATIO +# ( +# c1 CHAR(5) CHARACTER SET LATIN NOT CASESPECIFIC, +# c2 NUMBER, +# c3 NUMBER) +# PRIMARY INDEX ( c1 ); +# +# To verify each entry of c3: +res1 = tdQuery("select c3 from numManip2 where c1='2'") == 2 +stopifnot(res1) + +res2 = tdQuery("select c3 from numManip2 where c1='5'") == 5 +stopifnot(res2) + +res3 = tdQuery("select c3 from numManip2 where c1='4'") == 4 +stopifnot(res3) + +res4 = tdQuery("select c3 from numManip2 where c1='3'") == 3 +stopifnot(res4) + +res5 = tdQuery("select c3 from numManip2 where c3='1'") == 1 +stopifnot(res5) \ No newline at end of file diff --git a/test/testTRUNC.R b/test/testTRUNC.R new file mode 100644 index 0000000..52a5d13 --- /dev/null +++ b/test/testTRUNC.R @@ -0,0 +1,37 @@ +# Below is the table used for the test, called "numManip" +# c1 c2 +# ----- ---------------------------------------- +# 2 8.289 +# 5 13.99 +# 4 17.06 +# 3 48.1 +# 1 555.3 +# +# the R code is below: +tdf <- td.data.frame("numManip") +tdf["c3"] <- TRUNC(tdf["c2"], 1) +as.td.data.frame(tdf, tableName="numManip2") +# Below are the results of the table, when you type "select * from numManip2" +# c1 c2 c3 +# ----- ---------------------------------------- ------------------------- +# 2 8.289 8.2 +# 5 13.99 13.9 +# 4 17.06 17 +# 3 48.1 48.1 +# 1 555.3 555.3 +# +# To verify each entry of c3: +res1 = tdQuery("select c3 from numManip2 where c1='2'") == 8.2 +stopifnot(res1) + +res2 = tdQuery("select c3 from numManip2 where c1='5'") == 13.9 +stopifnot(res2) + +res3 = tdQuery("select c3 from numManip2 where c1='4'") == 17 +stopifnot(res3) + +res4 = tdQuery("select c3 from numManip2 where c1='3'") == 48.1 +stopifnot(res4) + +res5 = tdQuery("select c3 from numManip2 where c1='1'") == 555.3 +stopifnot(res5) \ No newline at end of file diff --git a/test/testUtil.R b/test/testUtil.R new file mode 100755 index 0000000..baeec57 --- /dev/null +++ b/test/testUtil.R @@ -0,0 +1,25 @@ +#test makePartition() +#res= .td.makePartition("col1, col2") == "partition by col1, col2" +#print(res) +#stopifnot(res) + +#res = .td.makePartition(partition = "any") == "partition by any" +#stopifnot(res) + +#test makeHash() +#res = .td.makeHash("col1") == "hash by col1" +#stopifnot(res) + +#res = .td.makeHash("col1") == "nope" +#stopifnot(res) + +#test makeOrder() +#res = .td.makeOrder("col1, col2") == "order by col1, col2" +#stopifnot(res) + +#test makeDimension() +#res = .td.makeDimension() == "dimension" +#stopifnot(res) + +#test makeLocalOrder() +#res = .td.makeLocalOrder("col1")