From 88eaa2bbb19ab40626c34bfd96710f997dde4835 Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 18:23:42 -0500 Subject: [PATCH 1/9] Replaced 1:length(Symbols) [1] 1 0 by seq_along(Symbols) If no symbols are found for(i in 1:length(Symbols)) { Browse[2]> 1:length(Symbols) [1] 1 0 But then this is correct. Browse[2]> seq_along(Symbols) # REPLACED integer(0) Browse[2]> --- R/getSymbols.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/getSymbols.R b/R/getSymbols.R index 1c1761a3..c48a9a3b 100644 --- a/R/getSymbols.R +++ b/R/getSymbols.R @@ -149,7 +149,7 @@ formals(loadSymbols) <- loadSymbols.formals # stop(paste("package:",dQuote('RBloomberg'),"cannot be loaded.")) # } # bbconn <- blpConnect() -# for(i in 1:length(Symbols)) { +# for(i in seq_along(Symbols)) { # bbsym <- paste(Symbols[[i]],bb.suffix) # # if(verbose) { @@ -238,7 +238,7 @@ function(Symbols,env,return.class='xts',index.class="Date", tmp <- tempfile() on.exit(unlink(tmp)) - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class return.class <- ifelse(is.null(return.class),default.return.class, return.class) @@ -327,7 +327,7 @@ function(Symbols,env,return.class='xts',index.class="Date", stop("package:",dQuote("XML"),"cannot be loaded.") yahoo.URL <- "http://info.finance.yahoo.co.jp/history/" - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { # The name of the symbol, which will actually be used as the # variable name. It needs to start with YJ, and it will be appended # if it does not. @@ -483,7 +483,7 @@ function(Symbols,env,return.class='xts', tmp <- tempfile() on.exit(unlink(tmp)) - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name) if(verbose) cat("downloading ",Symbols.name,".....\n\n") @@ -558,7 +558,7 @@ function(Symbols,env,return.class='xts', warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', '))) Symbols <- Symbols[Symbols %in% db.Symbols] } - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { if(verbose) { cat(paste('Loading ',Symbols[[i]], paste(rep('.',10-nchar(Symbols[[i]])),collapse=''), @@ -627,7 +627,7 @@ function(Symbols,env,return.class='xts', warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', '))) Symbols <- Symbols[Symbols %in% db.Symbols] } - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { if(verbose) { cat(paste('Loading ',Symbols[[i]],paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),sep='')) } @@ -669,7 +669,7 @@ function(Symbols,env,return.class='xts', tmp <- tempfile() on.exit(unlink(tmp)) - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { if(verbose) cat("downloading ",Symbols[[i]],".....\n\n") URL <- paste(FRED.URL, "/", Symbols[[i]], "/downloaddata/", Symbols[[i]], ".csv", sep="") try.download.file(URL, destfile=tmp, quiet=!verbose, ...) @@ -772,7 +772,7 @@ function(Symbols,env, if(!hasArg(verbose)) verbose <- FALSE if(!hasArg(auto.assign)) auto.assign <- TRUE - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class return.class <- ifelse(is.null(return.class),default.return.class, return.class) @@ -841,7 +841,7 @@ function(Symbols,env, if(!hasArg(verbose)) verbose <- FALSE if(!hasArg(auto.assign)) auto.assign <- TRUE - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class return.class <- ifelse(is.null(return.class),default.return.class, return.class) @@ -900,7 +900,7 @@ function(Symbols,env, if(!hasArg(verbose)) verbose <- FALSE if(!hasArg(auto.assign)) auto.assign <- TRUE - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class return.class <- ifelse(is.null(return.class),default.return.class, return.class) @@ -963,7 +963,7 @@ useRTH = '1', whatToShow = 'TRADES', time.format = '1', ...) if(missing(endDateTime)) endDateTime <- NULL - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { Contract <- getSymbolLookup()[[Symbols[i]]]$Contract if(inherits(Contract,'twsContract')) { fr <- do.call('reqHistoricalData',list(tws, Contract, endDateTime=endDateTime, @@ -1044,7 +1044,7 @@ function(Symbols,env,return.class='xts', tmp <- tempfile() on.exit(unlink(tmp)) - for(i in 1:length(Symbols)) { + for(i in seq_along(Symbols)) { return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class return.class <- ifelse(is.null(return.class),default.return.class, return.class) From 76a4c2c9326ba3fc57e7cffb306893b6a217fcf6 Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 19:00:19 -0500 Subject: [PATCH 2/9] getSymbols.PostgreSQL.Rd initial commit Heavily based on getSymbols.MySQL.Rd, but it has some PostgreSQL specifics. --- man/getSymbols.PostgreSQL.Rd | 111 +++++++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 man/getSymbols.PostgreSQL.Rd diff --git a/man/getSymbols.PostgreSQL.Rd b/man/getSymbols.PostgreSQL.Rd new file mode 100644 index 00000000..c73eec72 --- /dev/null +++ b/man/getSymbols.PostgreSQL.Rd @@ -0,0 +1,111 @@ +\name{getSymbols.PostgreSQL} +\alias{getSymbols.PostgreSQL} +\alias{getSymbols.PostgreSQL} +\title{ Retrieve Data from PostgreSQL Database } +\description{ +Fetch data from PostgreSQL database. As with other +methods extending the \code{getSymbols} function, +this should \emph{NOT} be called directly. Its +documentation is meant to highlight the formal +arguments, as well as provide a reference for +further user contributed data tools. +} +\usage{ +getSymbols.PostgreSQL(Symbols, + env, + return.class = 'xts', + db.fields = c("date", "o", "h", "l", "c", "v", "a"), + field.names = NULL, + user = NULL, + password = NULL, + dbname = NULL, + host = "localhost", + port = 5432, + options = "", + search_path=NULL, + ...) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{Symbols}{ a character vector specifying + the names of each symbol to be loaded} + \item{env}{ where to create objects. (.GlobalEnv)} + \item{return.class}{ desired class of returned object. + Can be xts, + zoo, data.frame, ts, or its. (zoo)} + \item{db.fields}{ character vector indicating + names of fields to retrieve} + \item{field.names}{ names to assign to returned columns } + \item{user}{ username to access database } + \item{password}{ password to access database } + \item{dbname}{ database name } + \item{host}{ database host } + \item{port}{ database port } + \item{options}{ command-line options to be sent to the server } + \item{search_path}{ schema path for table search } + \item{\dots}{ currently not used } +} +\details{ +Meant to be called internally by \code{getSymbols} (see also) + +One of a few currently defined methods for loading data for +use with \pkg{quantmod}. Its use requires the packages +\pkg{DBI} and \pkg{PostgreSQL}, along with a running +PostgreSQL database with tables corresponding to the +\code{Symbol} name. + +The purpose of this abstraction is to make transparent the +\sQuote{source} of the data, allowing instead the user to +concentrate on the data itself. +} +\value{ +A call to getSymbols.PostgreSQL will load into the specified +environment one object for each \code{Symbol} specified, +with class defined by \code{return.class}. +} +\references{ +\itemize{ + \cite{PostgreSQL \url{https://www.postgresql.org}} + + \cite{R-SIG-DB. DBI: R Database Interface} + } + } +\author{ Jeffrey A. Ryan and Andre I. Mikulec } +\note{ +The default configuration needs a table named +for the Symbol specified (e.g. MSFT), with +column names date,o,h,l,c,v,a. For table +layout changes it is best to use +\code{setDefaults(getSymbols.PostgreSQL,...)} with +the new db.fields values specified. +} +\seealso{ \code{\link{getSymbols}}, + \code{\link{setSymbolLookup}} } +\examples{ +\dontrun{ +# All 3 getSymbols calls return the same +# MSFT to the global environment +# The last example is what NOT to do! + +setDefaults(getSymbols.PostgreSQL,user='jdoe',password='secret', + dbname='tradedata',search_path='usschema') + +## Method #1 +getSymbols('MSFT',src='PostgreSQL') + + +## Method #2 +setDefaults(getSymbols,src='PostgreSQL') + # OR +setSymbolLookup(MSFT='PostgreSQL') + +getSymbols('MSFT') + +######################################### +## NOT RECOMMENDED!!! +######################################### +## Method #3 +getSymbols.PostgreSQL('MSFT',env=globalenv()) +} +} +\keyword{ data } From ce7a07ea3bdaeb28e90a55361c3e6130bd2c8d6d Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 19:08:00 -0500 Subject: [PATCH 3/9] added getSymbols.PostgreSQL --- R/getSymbols.R | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/R/getSymbols.R b/R/getSymbols.R index c48a9a3b..b8e940f4 100644 --- a/R/getSymbols.R +++ b/R/getSymbols.R @@ -654,6 +654,71 @@ function(Symbols,env,return.class='xts', "getSymbols.mysql" <- getSymbols.MySQL # }}} +# getSymbols.PostgreSQL {{{ +"getSymbols.PostgreSQL" <- function(Symbols,env,return.class='xts', + db.fields=c('date','o','h','l','c','v','a'), + field.names = NULL, + user=NULL,password=NULL,dbname=NULL,host='localhost',port=5432,options="",search_path=NULL, + ...) { + importDefaults("getSymbols.PostgreSQL") + this.env <- environment() + for(var in names(list(...))) { + # import all named elements that are NON formals + assign(var, list(...)[[var]], this.env) + } + if(!hasArg(verbose)) verbose <- FALSE + if(!hasArg(auto.assign)) auto.assign <- TRUE + + if(!requireNamespace("DBI", quietly=TRUE)) + stop("package:",dQuote("DBI"),"cannot be loaded.") + if(!requireNamespace("RPostgreSQL", quietly=TRUE)) + stop("package:",dQuote("RPostgreSQL"),"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")) + } + con <- DBI::dbConnect(RPostgreSQL::PostgreSQL(),user=user,password=password,dbname=dbname,host=host,port=port,options=options) + + if(!is.null(search_path)) { + dbGetQuery(con, paste0("set search_path to ", search_path) ) + } + + db.Symbols <- DBI::dbListTables(con) + if(length(Symbols) != sum(tolower(Symbols) %in% db.Symbols)) { + missing.db.symbol <- Symbols[!tolower(Symbols) %in% db.Symbols] + warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', '))) + Symbols <- Symbols[tolower(Symbols) %in% db.Symbols] + } + for(i in seq_along(Symbols)) { + if(verbose) { + cat(paste('Loading ',Symbols[[i]],paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),sep='')) + } + query <- paste("SELECT ",paste(db.fields,collapse=',')," FROM ",Symbols[[i]]," ORDER BY date") + rs <- DBI::dbSendQuery(con, query) + fr <- DBI::fetch(rs, n=-1) + #fr <- data.frame(fr[,-1],row.names=fr[,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]], + c('Open','High','Low','Close','Volume','Adjusted'), + sep='.') + fr <- convert.time.series(fr=fr,return.class=return.class) + if(auto.assign) + assign(Symbols[[i]],fr,env) + if(verbose) cat('done\n') + } + DBI::dbDisconnect(con) + if(auto.assign) + return(Symbols) + return(fr) +} +"getSymbols.PostgreSQL" <- getSymbols.PostgreSQL +# }}} + # getSymbols.FRED {{{ `getSymbols.FRED` <- function(Symbols,env, return.class="xts", ...) { From 8b7314415b1abee0e6f771d9a85e65b6624d21ae Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 19:09:36 -0500 Subject: [PATCH 4/9] added getSymbols.PostgreSQL --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 37852cfd..adc183ea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -250,6 +250,7 @@ export( loadSymbols, getSymbols, getSymbols.MySQL, + getSymbols.PostgreSQL, getSymbols.SQLite, getSymbols.mysql, getSymbols.FRED, From a7c4060dec2da7b038c560faeef4822f5075888b Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 19:42:47 -0500 Subject: [PATCH 5/9] update typo --- man/getSymbols.PostgreSQL.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/getSymbols.PostgreSQL.Rd b/man/getSymbols.PostgreSQL.Rd index c73eec72..0bf1d8d9 100644 --- a/man/getSymbols.PostgreSQL.Rd +++ b/man/getSymbols.PostgreSQL.Rd @@ -50,7 +50,7 @@ Meant to be called internally by \code{getSymbols} (see also) One of a few currently defined methods for loading data for use with \pkg{quantmod}. Its use requires the packages -\pkg{DBI} and \pkg{PostgreSQL}, along with a running +\pkg{DBI} and \pkg{RPostgreSQL}, along with a running PostgreSQL database with tables corresponding to the \code{Symbol} name. From 31334108100c88f76a61a14d70aa6f6175d57eda Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 20:48:31 -0500 Subject: [PATCH 6/9] Comments on lowercase table names in PostgreSQL --- man/getSymbols.PostgreSQL.Rd | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/man/getSymbols.PostgreSQL.Rd b/man/getSymbols.PostgreSQL.Rd index 0bf1d8d9..96c0c5a6 100644 --- a/man/getSymbols.PostgreSQL.Rd +++ b/man/getSymbols.PostgreSQL.Rd @@ -66,7 +66,6 @@ with class defined by \code{return.class}. \references{ \itemize{ \cite{PostgreSQL \url{https://www.postgresql.org}} - \cite{R-SIG-DB. DBI: R Database Interface} } } @@ -79,6 +78,18 @@ layout changes it is best to use \code{setDefaults(getSymbols.PostgreSQL,...)} with the new db.fields values specified. } +\note{ +Also the user may have a PostgreSQL table named msft(lowercase). +In that situation the returned symbol will be msft(lowercase). +The returned columns will be msft.Open, msft.High, etc. +However, it is recommeded to work with upper case xts object +names e.g. MSFT to be consistent with the rest +of the quantmod workflow. +In R an xts object and it's column uppercase +or lowercase names can be changed +with the functions tolower and toupper. +Mixed case PostgreSQL table names are not supported. +} \seealso{ \code{\link{getSymbols}}, \code{\link{setSymbolLookup}} } \examples{ From 19a4c93c4c89d602e6a6cb671ac81e7faa54d0bf Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 20:51:35 -0500 Subject: [PATCH 7/9] PostgreSQL lowercase table names --- R/getSymbols.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/getSymbols.R b/R/getSymbols.R index b8e940f4..e647ff74 100644 --- a/R/getSymbols.R +++ b/R/getSymbols.R @@ -687,16 +687,18 @@ function(Symbols,env,return.class='xts', } db.Symbols <- DBI::dbListTables(con) - if(length(Symbols) != sum(tolower(Symbols) %in% db.Symbols)) { - missing.db.symbol <- Symbols[!tolower(Symbols) %in% db.Symbols] + if(length(Symbols) != sum(tolower(Symbols) %in% tolower(db.Symbols))) { + missing.db.symbol <- Symbols[!tolower(Symbols) %in% tolower(db.Symbols)] warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', '))) - Symbols <- Symbols[tolower(Symbols) %in% db.Symbols] + Symbols <- Symbols[tolower(Symbols) %in% tolower(db.Symbols)] } for(i in seq_along(Symbols)) { if(verbose) { cat(paste('Loading ',Symbols[[i]],paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),sep='')) } - query <- paste("SELECT ",paste(db.fields,collapse=',')," FROM ",Symbols[[i]]," ORDER BY date") + query <- paste0("SELECT ",paste(db.fields,collapse=',')," FROM \"", + if(any(Symbols[[i]] == tolower(db.Symbols))) { tolower(Symbols[[i]]) } else { toupper(Symbols[[i]]) } + , "\" ORDER BY date") rs <- DBI::dbSendQuery(con, query) fr <- DBI::fetch(rs, n=-1) #fr <- data.frame(fr[,-1],row.names=fr[,1]) From 99c8b0bb7a36ad13ae29063f168c1f8c65b7777b Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Sun, 5 Jun 2016 20:54:52 -0500 Subject: [PATCH 8/9] Further comment on a not allowed mixed case PostgreSQL table naem --- man/getSymbols.PostgreSQL.Rd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/man/getSymbols.PostgreSQL.Rd b/man/getSymbols.PostgreSQL.Rd index 96c0c5a6..c8db0601 100644 --- a/man/getSymbols.PostgreSQL.Rd +++ b/man/getSymbols.PostgreSQL.Rd @@ -79,7 +79,8 @@ layout changes it is best to use the new db.fields values specified. } \note{ -Also the user may have a PostgreSQL table named msft(lowercase). +Also in this particular getSymbols implementation, +the user may have a PostgreSQL table named msft(lowercase). In that situation the returned symbol will be msft(lowercase). The returned columns will be msft.Open, msft.High, etc. However, it is recommeded to work with upper case xts object @@ -89,6 +90,7 @@ In R an xts object and it's column uppercase or lowercase names can be changed with the functions tolower and toupper. Mixed case PostgreSQL table names are not supported. +Therefore, a PostgreSQL table named MsFt will cause an Error. } \seealso{ \code{\link{getSymbols}}, \code{\link{setSymbolLookup}} } From a25855717b53089124b49391fd627922db673097 Mon Sep 17 00:00:00 2001 From: AndreMikulec Date: Tue, 7 Jun 2016 12:54:20 -0500 Subject: [PATCH 9/9] Suggests RPostgreSQL --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d158acc8..f60c7bcd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,7 @@ Authors@R: c( person(given="Wouter", family="Thielen", role="ctb") ) Depends: xts(>= 0.9-0), zoo, TTR(>= 0.2), methods -Suggests: DBI,RMySQL,RSQLite,timeSeries,its,XML,downloader +Suggests: DBI,RMySQL,RPostgreSQL,RSQLite,timeSeries,its,XML,downloader Description: Specify, build, trade, and analyse quantitative financial trading strategies. LazyLoad: yes License: GPL-3