joshuaulrich / quantmod Goto Github PK

sure

install.packages("quantmod")
# lightweight
remotes::install_github("joshuaulrich/quantmod")
# or
devtools::install_github("joshuaulrich/quantmod")
> getSymbols("AAPL", src = "yahoo")    # from yahoo finance
[1] "AAPL"
> getSymbols("DEXJPUS", src = "FRED")  # FX rates from FRED
[1] "DEXJPUS"
> getSymbols("AAPL")
[1] "AAPL"
> chartSeries(AAPL)
> addMACD()
> addBBands()
Index: pkg/R/getSymbols.R
===================================================================

--- pkg/R/getSymbols.R  (revision 611)
+++ pkg/R/getSymbols.R  (working copy)
@@ -687,6 +687,7 @@
   default.return.class <- return.class
   default.dir <- dir
   default.extension <- extension
+  default.col.names <- col.names

   if(missing(verbose)) verbose <- FALSE
   if(missing(auto.assign)) auto.assign <- TRUE
@@ -701,6 +702,10 @@
     extension <- getSymbolLookup()[[Symbols[[i]]]]$extension
     extension <- ifelse(is.null(extension),default.extension,
                            extension)
+
+    col.names <- getSymbolLookup()[[Symbols[[i]]]]$col.names
+    col.names <- if(is.null(col.names)) default.col.names else col.names
+ 
     if(verbose) cat("loading ",Symbols[[i]],".....")
     if(dir=="") {
       sym.file <- paste(Symbols[[i]],extension,sep=".")
@@ -717,6 +722,7 @@
     if(verbose)  
       cat("done.\n")
     if(!is.xts(fr)) fr <- xts(fr[,-1],as.Date(fr[,1],origin='1970-01-01'),src='rda',updated=Sys.time())
+    if(is.na(col.names)) col.names <- colnames(fr) # if NA, use original colnames
     colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])),col.names,sep='.')
     fr <- convert.time.series(fr=fr,return.class=return.class)
     Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) 
@@ -746,7 +752,8 @@
   default.return.class <- return.class
   default.dir <- dir
   default.extension <- extension
-
+  default.col.names <- col.names
+  
   if(missing(verbose)) verbose <- FALSE
   if(missing(auto.assign)) auto.assign <- TRUE

@@ -760,6 +767,10 @@
     extension <- getSymbolLookup()[[Symbols[[i]]]]$extension
     extension <- ifelse(is.null(extension),default.extension,
                            extension)
+
+    col.names <- getSymbolLookup()[[Symbols[[i]]]]$col.names
+    col.names <- if(is.null(col.names)) default.col.names else col.names
+    
     if(verbose) cat("loading ",Symbols[[i]],".....")
     if(dir=="") {
       sym.file <- paste(Symbols[[i]],extension,sep=".")
@@ -777,7 +788,8 @@
     if(verbose)  
       cat("done.\n")
     if(!is.xts(fr)) fr <- xts(fr[,-1],as.Date(fr[,1],origin='1970-01-01'),src='rda',updated=Sys.time())
-    colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])),col.names,sep='.')
+    if(is.na(col.names)) col.names <- colnames(fr) # if NA, use original colnames
+    colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])), col.names, sep='.')
     fr <- convert.time.series(fr=fr,return.class=return.class)
     Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) 
     if(auto.assign)

  save(list=each.symbol,
       file=paste(file.path,'/',each.symbol,'.RData',sep=''),
       env=env)

setDefaults(getSymbols, src='yahoo')
g <- function(x, ...) { getSymbols(x, ...) }
g('SPY')
Error in match.call(definition = eval(parse(text = calling.fun)), call = as.call(sys.call(-1))) : 
  ... used in a situation where it doesn't exist
Index: attachSymbols.R
===================================================================
--- attachSymbols.R (revision 582)
+++ attachSymbols.R (working copy)
@@ -58,7 +58,7 @@
     if(mem.cache) {
       envir <- as.environment(envir)
       delayedAssign(lsym(s), { 
-                    assign(lsym(s),getSymbols(rsym(s),auto.assign=FALSE, src=gsrc, ...), env=envir)
+                    assign(lsym(s), do.call(getSymbols, rsym(s), auto.assign=FALSE, src=gsrc, ...), env=envir)
                     get(lsym(s), env=envir) },
                     assign.env=envir)
     } else { # no cache

library(quantmod)
setDefaults(getSymbols.MySQL,user="****", password="****", dbname="quantmoddb")
getSymbols("myspy",src="MySQL")
#Error in (function (classes, fdef, mtable)  : 
#unable to find an inherited method for function ‘dbConnect’ for signature ‘"character"’
con <- dbConnect(RMySQL::MySQL(), user="****", password="****",
                 dbname="quantmoddb", host="localhost", port=3306) 
db.Symbols <- DBI::dbListTables(con)
query <- paste("SELECT * from myspy ORDER BY date")
rs <- DBI::dbSendQuery(con, query)
fr <- DBI::fetch(rs, n=-1)
Index: pkg/R/chartSeries.R
===================================================================
--- pkg/R/chartSeries.R (revision 611)
+++ pkg/R/chartSeries.R (working copy)
@@ -378,7 +378,7 @@
          major.ticks='auto',minor.ticks=TRUE,
          yrange=NULL,
          plot=TRUE,
-         up.col,dn.col,color.vol=TRUE,multi.col=FALSE,...
+         up.col,dn.col,color.vol=TRUE,multi.col=FALSE, na.omit=TRUE,...
          ) {
   #sys.TZ <- Sys.getenv('TZ')
   #Sys.setenv(TZ='GMT')
@@ -386,9 +386,9 @@

   #if(!is.xts(x)) x <- as.xts(x)
   x <- try.xts(x, error='chartSeries requires an xtsible object')
-
-  x <- na.omit(x)
-
+  if(na.omit==TRUE){
+    x <- na.omit(x)
+  }
   indexClass(x) <- "POSIXct"

   if(!is.null(subset) & is.character(subset)) {
Index: getDividends.R
===================================================================
--- getDividends.R  (revision 609)
+++ getDividends.R  (working copy)
@@ -2,8 +2,14 @@
 function(Symbol,from='1970-01-01',to=Sys.Date(),env=parent.frame(),src='yahoo',
          auto.assign=FALSE,auto.update=FALSE,verbose=FALSE,...) {

-  if(missing(env))
+  tmp.symbol <- Symbol
+  if(missing(env)) {
     env <- parent.frame(1)
+  } else {
+    if(exists(Symbol, envir = env)) {
+      tmp.symbol <- get(Symbol, envir = env)
+    }
+  }
   if(is.null(env))
     auto.assign <- FALSE
   Symbol.name <- ifelse(!is.character(Symbol),
@@ -27,10 +33,11 @@
   fr <- read.csv(tmp)
   unlink(tmp)
   fr <- xts(fr[,2],as.Date(fr[,1]))
-  if(is.xts(Symbol)) {
+
+  if(is.xts(tmp.symbol)) {
     if(auto.update) {
-      xtsAttributes(Symbol) <- list(dividends=fr)
-      assign(Symbol.name,Symbol,envir=env)
+      xtsAttributes(tmp.symbol) <- list(dividends=fr)
+      assign(Symbol.name,tmp.symbol,envir=env)
     }
   } else if(auto.assign) {
       assign(paste(Symbol.name,'div',sep='.'),fr,envir=env)
Index: getSplits.R
===================================================================
--- getSplits.R (revision 609)
+++ getSplits.R (working copy)
@@ -4,8 +4,13 @@

   # Function written by Joshua Ulrich, using
   # getSymbols.yahoo as a guide.
-  if(missing(env))
+  if(missing(env)) {
     env <- parent.frame(1)
+  } else {
+    if(exists(Symbol, envir = env)) {
+      tmp.symbol <- get(Symbol, envir = env)
+    }
+  }
   if(is.null(env))
     auto.assign <- FALSE
   Symbol.name <- ifelse(!is.character(Symbol),
@@ -39,10 +44,10 @@
     colnames(fr) <- paste(Symbol.name,'spl',sep='.')
   }

-  if(is.xts(Symbol)) {
+  if(is.xts(tmp.symbol)) {
     if(auto.update) {
-      xtsAttributes(Symbol) <- list(splits=fr)
-      assign(Symbol.name,Symbol,envir=env)
+      xtsAttributes(tmp.symbol) <- list(splits=fr)
+      assign(Symbol.name,tmp.symbol,envir=env)
     }
   } else if(auto.assign) {
       assign(paste(Symbol.name,'spl',sep='.'),fr,envir=env)
Index: man/getSymbols.MySQL.Rd
===================================================================
--- man/getSymbols.MySQL.Rd (revision 582)
+++ man/getSymbols.MySQL.Rd (working copy)
@@ -21,6 +21,7 @@
                  dbname = NULL, 
                  host = "localhost", 
                  port = 3306, 
+                 conn = NULL, 
                  ...)
 }
 %- maybe also 'usage' for other objects documented here.
@@ -39,6 +40,7 @@
        \item{dbname}{ database name }
        \item{host}{ database host }
        \item{port}{ database port }
+       \item{conn}{ DBI connection }
        \item{\dots}{ currently not used }
 }
 \details{
@@ -53,6 +55,8 @@
 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.
+
+If conn is supplied, the other database values are unneccessary.
 }
 \value{
 A call to getSymbols.MySQL will load into the specified
@@ -83,7 +87,7 @@
           \code{\link{setSymbolLookup}} }
 \examples{
 \dontrun{
-# All 3 getSymbols calls return the same
+# All 4 getSymbols calls return the same
 # MSFT to the global environment
 # The last example is what NOT to do!

@@ -101,10 +105,15 @@

 getSymbols('MSFT')

+## Method #3
+# Uses DBI connection
+conn = dbConnect('MySQL',dbname='test')
+getSymbols('MSFT',conn=conn)
+
 #########################################
 ##  NOT RECOMMENDED!!!
 #########################################
-## Method #3
+## Method #4
 getSymbols.MySQL('MSFT',env=globalenv())
 }
 }
Index: R/getSymbols.R
===================================================================
--- R/getSymbols.R  (revision 582)
+++ R/getSymbols.R  (working copy)
@@ -418,7 +418,7 @@
 "getSymbols.MySQL" <- 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=3306,
+                               user=NULL,password=NULL,dbname=NULL,host='localhost',port=3306,conn=NULL,
                                ...) {
      importDefaults("getSymbols.MySQL")
      this.env <- environment()
@@ -434,13 +434,18 @@
         } else {
           stop(paste("package:",dQuote('DBI'),"cannot be loaded."))
         }
-        if(is.null(user) || is.null(password) || is.null(dbname)) {
+       if(!is.null(conn)) {
+           # reusing connection
+        } else 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 <- dbConnect(MySQL(),user=user,password=password,dbname=dbname,host=host,port=port)
+        if(is.null(conn)) 
+           con <- dbConnect(MySQL(),user=user,password=password,dbname=dbname,host=host,port=port)
+       else
+           con <- conn
         db.Symbols <- dbListTables(con)
         if(length(Symbols) != sum(Symbols %in% db.Symbols)) {
           missing.db.symbol <- Symbols[!Symbols %in% db.Symbols]
@@ -466,7 +471,8 @@
               assign(Symbols[[i]],fr,env)
             if(verbose) cat('done\n')
         }
-        dbDisconnect(con)
+       if(is.null(conn))
+           dbDisconnect(con)
         if(auto.assign)
           return(Symbols)
         return(fr)
require(quantmod)
data(sample_matrix)
x <- as.xts(sample_matrix)
m <- EMA(Cl(x))
chartSeries(x, TA=NULL)
addEMA(10)
addTA(m, on=-1, col='red')
if (!is.OHLC(x) || missing(with.col)) 
  with.col <- 1
if (!is.OHLC(x) && missing(with.col)) 
  with.col <- 1
Index: R/axTicksByTime2.R
===================================================================
--- R/axTicksByTime2.R  (revision 582)
+++ R/axTicksByTime2.R  (working copy)
@@ -6,8 +6,8 @@
         x <- xts(rep(1, length(x)), x)
     #tick.opts <- c("years", "months", "days", "hours", 
     #    "minutes", "seconds")
-    tick.opts <- c("years", "months", "weeks", "days")
-    tick.k.opts <- c(1,1,1,1)
+    tick.opts <- c("years", "quarters", "months", "weeks", "days")
+    tick.k.opts <- c(1,1,1,1,1)
     if (ticks.on %in% tick.opts) {
         cl <- ticks.on[1]
         ck <- k
@@ -43,6 +43,7 @@
             #fmt <- ifelse(unix, "%n%b%n%Y", "%b %Y")
             fmt <- switch(cl,
                           "years"="%Y",
+                          "quarters"="%Y Q%q",
                           "months"="%b",
                           "days"="%d",
                           "weeks"="W%W",
Index: R/chart_Series.R
===================================================================
--- R/chart_Series.R    (revision 582)
+++ R/chart_Series.R    (working copy)
@@ -300,7 +300,7 @@
           {axis(1,at=1:NROW(xdata[xsubset]),labels=FALSE,col=theme$grid2,tcl=0.3)}),expr=TRUE)

   # add "month" or "month.abb"
-  cs$add(expression(axt <- axTicksByTime(xdata[xsubset],format.labels=format.labels),
+  cs$add(expression(axt <- axTicksByTime2(xdata[xsubset],format.labels=format.labels),
                 axis(1,at=axt, #axTicksByTime(xdata[xsubset]),
                 labels=names(axt), #axTicksByTime(xdata[xsubset],format.labels=format.labels)),
                 las=1,lwd.ticks=1,mgp=c(3,1.5,0),tcl=-0.4,cex.axis=.9)),

getSymbols('LOW', src='yahoo')
LOW.uA <- adjustOHLC(LOW, use.Adjusted=TRUE)

Error message:
Error in `-.default`(Lo(x), Cl(x)) : array incompatibili
`Lo` <-
function(x)
{
  if(has.Lo(x))
    return(x[,grep('Low',colnames(x),ignore.case=TRUE)])
  stop('subscript out of bounds: no column name containing 'Low'')
}
`Lo` <-
function(x)
{ 
  if(has.Lo(x)) {
      #prevent LOW.Low
      if(length(grep('\.',colnames(x)[[1]]))){
        return(x[,grep('.Low',colnames(x),ignore.case=TRUE)])
      } else {
        return(x[,grep('Low',colnames(x),ignore.case=TRUE)])
      }
  }
  stop('subscript out of bounds: no column name containing 'Low'')
}
thm <- chart_theme()

getSymbols('SPY', src='yahoo', from='2012-01-01', to='2012-11-01')
thm$col$bg <- 'black'
chart_Series(SPY, theme=thm) # shouldn't this have a black background?

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',
getOptionQuotes = function(symbol) {
  library(RCurl)
  library(jsonlite)
  library(plyr)
  fixJSON = function(json){
    gsub('([^,{:]+):', '"\\1":', json)
  }
  URL1 = 'http://www.google.com/finance/option_chain?q=%s&output=json'
  URL2 = paste0(URL1, '&expy=%d&expm=%d&expd=%d')

  url = sprintf(URL1, symbol)
  chain = fromJSON(fixJSON(getURL(url)))
  options = mlply(chain$expirations, function(y, m, d) {
    url = sprintf(URL2, symbol, y, m, d)
    expiry = fromJSON(fixJSON(getURL(url)))
    expiry$calls$type = "Call"
    expiry$puts$type  = "Put"

    prices = rbind(expiry$calls, expiry$puts)
    prices$expiry = sprintf("%4d-%02d-%02d", y, m, d)
    prices$underlying.price = expiry$underlying_price
    prices$retrieved = Sys.time()
    prices
  })

  options = options[sapply(options, class) == "data.frame"]
  options = cbind(data.frame(symbol), rbind.fill(options))
  options = rename(options, c(p="premium", b="bid", a="ask", oi="open.interest"))
  for (col in c("strike", "premium", "bid", "ask"))
    options[, col] = suppressWarnings(as.numeric(options[, col]))
  options[, "open.interest"] = suppressWarnings(as.integer(options[, "open.interest"]))
  col.order = c("symbol", "type", "expiry", "strike", "premium",
                "bid", "ask", "open.interest", "retrieved")
  options[, col.order]
}
bcb0dc9
function(Symbols=NULL, 
         env=getOption(getSymbols.env, parent.frame()), 
         reload.Symbols=getOption(getSymbols.reload.Symbol, FALSE), 
         verbose=getOption(getSymbols.verbose, FALSE), 
         warnings=getOption(getSymbols.warnings, TRUE), 
         src=getOption(getSymbols.src, 'yahoo'), 
         symbol.lookup=getOption(getSymbols.symbol.lookup, TRUE), 
         auto.assign=getOption('getSymbols.auto.assign', TRUE), ...) 

function(Symbols, 
         env=getOption(getSymbols.yahoo.env), 
         return.class=getOption(getSymbols.yahoo.return.class, 'xts'), 
         index.class=getOption(getSymbols.yahoo.index.class, 'Date'), 
         from=getOption(getSymbols.yahoo.from, '2007-01-01'), 
         to=getOption(getSymbols.yahoo.to, Sys.Date()), ...)

useYahoo <- function() {
  options(getSymbols.src='yahoo')
  options(getSymbols.yahoo.from='2014-01-01')
}


joshuaulrich / quantmod Goto Github PK

quantmod's Introduction

About

quantmod for enterprise

Supporting quantmod development

Installation

Getting Started

Have a question?

Contributing

See Also

Author

quantmod's People

Contributors

Stargazers

Watchers

Forkers

quantmod's Issues

Some sample data

create a vector to hold color names

if the vector of color names is named something else, it works.

The following should plot a lightblue line,

but instead plots an orange line

A workaround is to use add_TA with a 'col' argument

(add_TA does not support the use of the 'theme' argument)

Recommend Projects

Recommend Topics

Recommend Org