joshuaulrich / joshuaulrich/quantmod

[R-Forge #1326] JDBC support

Open
#28 0 comments 0 reactions 0 assignees View on GitHub
feature request
Dominant language
R
Stars
906
Forks
233
PR merge metrics
No merged PRs in 30d

Description

Submitted by: Hasan Diwan
Assigned to: Nobody
[R-Forge link](http://r-forge.r-project.org/tracker/index.php?func=detail&aid=1326&group_id=125&atid=547)

The attached patch adds support for JDBC and a weak dependency on RJDBC, similar to the one on RMySQL, which is what the new method is based on. The RJDBC code has been independently tested and works, albeit a tad slowly, which I'm going to assume is due to RJDBC slowness, which seems to be well-known[1].
1. https://stat.ethz.ch/pipermail/r-sig-db/2010q2/000841.html, http://www.mail-archive.com/r-help@r-project.org/msg99946.html, among others.

----

```diff
Index: pkg/R/getSymbols.R
===================================================================
--- pkg/R/getSymbols.R (revision 559)
+++ pkg/R/getSymbols.R (working copy)
@@ -315,6 +317,64 @@
}
"getSymbols.sqlite" <- getSymbols.SQLite
# }}}
+# getSymbols.JDBC {{{
+getSymbols.JDBC <- function (Symbols, env, return.class = "zoo", db.fields = c("startdate", "name", "value"), driver = 'org.postgresql.Driver', classPath='~/.m2/repository/postgresql/postgresql/9.0-801.jdbc4/postgresql-9.0.jdbc4.jar', url = 'jdbc:postgresql://localhost/erm', field.names = NULL, user = NULL, password = NULL, dbname = NULL, ...)
+{
+ this.env <- environment()
+ for (var in names(list(...))) {
+ assign(var, list(...)[[var]], this.env)
+ }
+ if (missing(verbose))
+ verbose <- FALSE
+ if (missing(auto.assign))
+ auto.assign <- TRUE
+ if ("package:DBI" %in% search() || require("DBI", quietly = TRUE)) {
+ if ("package:RJDBC" %in% search() || require("RJDBC", quietly = TRUE)) {
+ }
+ else {
+ warning(paste("package:", dQuote("RJDBC"), "cannot be loaded"))
+ }
+ }
+ else {
+ stop(paste("package:", dQuote("DBI"), "cannot be loaded."))
+ }
+ if (is.null(user) || is.null(password) || is.null(dbname)) {
+ stop(paste("At least one connection argument (", sQuote("user"),
+ sQuote("password"), sQuote("dbname"), ") is not set"))
+ }
+ drv <- JDBC(driver=driver, classPath = classPath)
+ con <- dbConnect(drv, url, user=user, password=password)
+ db.Symbols <- dbListTables(con)
+ if (length(Symbols) != sum(Symbols %in% db.Symbols)) {
+ missing.db.symbol <- Symbols[!Symbols %in% db.Symbols]
+ warning(paste("could not load symbol(s): ", paste(missing.db.symbol,
+ collapse = ", ")))
+ Symbols <- Symbols[Symbols %in% db.Symbols]
+ }
+ for (i in 1:length(Symbols)) {
+ if (verbose) {
+ cat(paste("Loading ", Symbols[[i]], paste(rep(".",
+ 10 - nchar(Symbols[[i]])), collapse = ""), sep = ""))
+ }
+ query <- paste("SELECT ", paste(db.fields, collapse = ","),
+ " FROM profiles, dists where profileid = p.id ORDER BY startdate")
+ rs <- dbSendQuery(con, query)
+ fr <- fetch(rs, n = -1)
+ fr <- xts(as.matrix(fr[, -1]), order.by = as.Date(fr[,
+ 1], origin = "1970-01-01"), src = dbname, updated = Sys.time())
+ colnames(fr) <- paste(Symbols[[i]], "Close", sep = ".")
+ fr <- convert.time.series(fr = fr, return.class = return.class)
+ if (auto.assign)
+ assign(Symbols[[i]], fr, env)
+ if (verbose)
+ cat("done\n")
+ }
+ dbDisconnect(con)
+ if (auto.assign)
+ return(Symbols)
+ return(fr)
+}
+# }}}

# getSymbols.MySQL {{{
"getSymbols.MySQL" <- function(Symbols,env,return.class='xts',
```

Contributor guide

No contributing guide indexed for this repository

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.