[Quantmod-commits] r624 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Dec 13 01:52:16 CET 2014


Author: bodanker
Date: 2014-12-13 01:52:16 +0100 (Sat, 13 Dec 2014)
New Revision: 624

Added:
   pkg/man/getSymbols.yahooj.Rd
Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/getSymbols.R
   pkg/man/quantmod-package.Rd
Log:
- Add getSymbols.yahooj function and documentation (request #5782)


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2014-12-12 17:14:13 UTC (rev 623)
+++ pkg/DESCRIPTION	2014-12-13 00:52:16 UTC (rev 624)
@@ -3,10 +3,13 @@
 Title: Quantitative Financial Modelling Framework
 Version: 0.4-3
 Date: 2014-12-08
-Author: Jeffrey A. Ryan
+Authors at R: c(
+  person(given=c("Jeffrey","A."), family="Ryan", role=c("aut","cph")),
+  person(given=c("Joshua","M."), family="Ulrich", role=c("cre","ctb"), email="josh.m.ulrich at gmail.com"),
+  person(given="Wouter", family="Thielen", role="ctb")
+  )
 Depends: xts(>= 0.9-0), zoo, TTR(>= 0.2), methods
-Suggests: DBI,RMySQL,RSQLite,timeSeries,its
-Maintainer: Joshua M. Ulrich <josh.m.ulrich at gmail.com>
+Suggests: DBI,RMySQL,RSQLite,timeSeries,its,XML
 Description: Specify, build, trade, and analyse quantitative financial trading strategies
 LazyLoad: yes
 License: GPL-3

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2014-12-12 17:14:13 UTC (rev 623)
+++ pkg/NAMESPACE	2014-12-13 00:52:16 UTC (rev 624)
@@ -201,6 +201,7 @@
     getSymbols.mysql,
     getSymbols.FRED,
     getSymbols.yahoo,
+    getSymbols.yahooj,
     getSymbols.oanda,
     #getSymbols.Bloomberg,
     #getSymbols.IBrokers,

Modified: pkg/R/getSymbols.R
===================================================================
--- pkg/R/getSymbols.R	2014-12-12 17:14:13 UTC (rev 623)
+++ pkg/R/getSymbols.R	2014-12-13 00:52:16 UTC (rev 624)
@@ -299,6 +299,162 @@
 }
 # }}}
 
+# getSymbols.yahooj {{{
+"getSymbols.yahooj" <-
+    function(Symbols, env=parent.frame(), return.class='xts', index.class="Date",
+             from='2007-01-01',
+             to=Sys.Date(),
+             ...)
+    {
+        importDefaults("getSymbols.yahooj")
+        this.env <- environment()
+        for(var in names(list(...))) {
+            # import all named elements that are NON formals
+            assign(var, list(...)[[var]], this.env)
+        }
+        if(!exists("adjust", environment(), inherits=FALSE))
+            adjust <- FALSE
+        
+        default.return.class <- return.class
+        default.from <- from
+        default.to <- to
+        
+        if(!hasArg(verbose)) verbose <- FALSE
+        if(!hasArg(auto.assign)) auto.assign <- TRUE
+
+        if(!('package:XML' %in% search() || require('XML',quietly=TRUE))) {
+            stop(paste("package:",dQuote("XML"),"cannot be loaded" ))
+        }
+
+        yahoo.URL <- "http://info.finance.yahoo.co.jp/history/"
+        for(i in 1:length(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.
+            symname <- toupper(Symbols[[i]])
+            
+            # The symbol actually sent to Yahoo Japan. This is without the
+            # starting YJ bit.
+            symbol <- symname
+            
+            # If it starts with YJ, try looking up defaults
+            if (grepl("^YJ", symname)) {
+                return.class <- getSymbolLookup()[[symname]]$return.class
+                return.class <- ifelse(is.null(return.class),default.return.class,
+                                       return.class)
+                from <- getSymbolLookup()[[symname]]$from
+                from <- if(is.null(from)) default.from else from
+                to <- getSymbolLookup()[[symname]]$to
+                to <- if(is.null(to)) default.to else to
+                
+                # Extract the actual symbol to be sent to Yahoo Japan
+                symbol <- substring(symname, 3)
+            } else {
+                return.class <- default.return.class
+                from <- default.from
+                to <- default.to
+                
+                # Prepend 'YJ' to the symbol and store it in symname
+                symname <- paste('YJ', symbol, sep="")
+            }
+
+            from.y <- as.numeric(strsplit(as.character(as.Date(from,origin='1970-01-01')),'-',)[[1]][1])
+            from.m <- as.numeric(strsplit(as.character(as.Date(from,origin='1970-01-01')),'-',)[[1]][2])
+            from.d <- as.numeric(strsplit(as.character(as.Date(from,origin='1970-01-01')),'-',)[[1]][3])
+            to.y <- as.numeric(strsplit(as.character(as.Date(to,origin='1970-01-01')),'-',)[[1]][1])
+            to.m <- as.numeric(strsplit(as.character(as.Date(to,origin='1970-01-01')),'-',)[[1]][2])
+            to.d <- as.numeric(strsplit(as.character(as.Date(to,origin='1970-01-01')),'-',)[[1]][3])
+            
+            Symbols.name <- getSymbolLookup()[[symname]]$name
+            Symbols.name <- ifelse(is.null(Symbols.name),symbol,Symbols.name)
+            if(verbose) cat("downloading ",Symbols.name,".....\n\n")
+            
+            page <- 1
+            totalrows <- c()
+            while (TRUE) {
+                tmp <- tempfile()
+                download.file(paste(yahoo.URL,
+                                    "?code=",Symbols.name,
+                                    "&sm=",from.m,
+                                    "&sd=",sprintf('%.2d',from.d),
+                                    "&sy=",from.y,
+                                    "&em=",to.m,
+                                    "&ed=",sprintf('%.2d',to.d),
+                                    "&ey=",to.y,
+                                    "&tm=d",
+                                    "&p=",page,
+                                    sep=''),destfile=tmp,quiet=!verbose)
+                
+                fdoc <- XML::htmlParse(tmp)
+                unlink(tmp)
+                
+                rows <- XML::xpathApply(fdoc, "//table[@class='boardFin yjSt marB6']//tr")
+                if (length(rows) == 1) break
+                
+                totalrows <- c(totalrows, rows)
+                page <- page + 1
+            }
+            if(verbose) cat("done.\n")
+            
+            # Available columns
+            cols <- c('Open','High','Low','Close','Volume','Adjusted')
+            if (grepl(".O$", Symbols.name)) cols <- cols[-(5:6)]
+            
+            # Process from the start, for easier stocksplit management
+            totalrows <- rev(totalrows)
+            mat <- matrix(0, ncol=length(cols) + 1, nrow=0, byrow=TRUE)
+            for(row in totalrows) {
+                cells <- XML::getNodeSet(row, "td")
+                
+                # 2 cells means it is a stocksplit row
+                # So extract stocksplit data and recalculate the matrix we have so far
+                if (length(cells) == 2 & length(cols) == 6 & nrow(mat) > 1) {
+                    ss.data <- as.numeric(na.omit(as.numeric(unlist(strsplit(XML::xmlValue(cells[[2]]), "[^0-9]+")))))
+                    factor <- ss.data[2] / ss.data[1]
+                    
+                    mat <- rbind(t(apply(mat[-nrow(mat),], 1, function(x) {
+                        x * c(1, rep(1/factor, 4), factor, 1)
+                    })), mat[nrow(mat),])
+                }
+                
+                if (length(cells) != length(cols) + 1) next
+                
+                # Parse the Japanese date format using UTF characters
+                # \u5e74 = 年
+                # \u6708 = 月
+                # \u65e5 = 日
+                date <- as.Date(XML::xmlValue(cells[[1]]), format="%Y\u5e74%m\u6708%d\u65e5")
+                entry <- c(date)
+                for(n in 2:length(cells)) {
+                    entry <- cbind(entry, as.numeric(gsub(",", "", XML::xmlValue(cells[[n]]))))
+                }
+                
+                mat <- rbind(mat, entry)
+            }
+            
+            fr <- xts(mat[, -1], as.Date(mat[, 1]), src="yahooj", updated=Sys.time())
+            
+            colnames(fr) <- paste(symname, cols, sep='.')
+            
+            fr <- convert.time.series(fr=fr,return.class=return.class)
+            if(is.xts(fr))
+                indexClass(fr) <- index.class
+            
+            Symbols[[i]] <- symname
+            if(auto.assign)
+                assign(Symbols[[i]],fr,env)
+            if(i >= 5 && length(Symbols) > 5) {
+                message("pausing 1 second between requests for more than 5 symbols")
+                Sys.sleep(1)
+            }
+            
+        }
+        if(auto.assign)
+            return(Symbols)
+        return(fr)
+    }
+# }}}
+
 # getSymbols.google {{{
 "getSymbols.google" <-
 function(Symbols,env,return.class='xts',

Added: pkg/man/getSymbols.yahooj.Rd
===================================================================
--- pkg/man/getSymbols.yahooj.Rd	                        (rev 0)
+++ pkg/man/getSymbols.yahooj.Rd	2014-12-13 00:52:16 UTC (rev 624)
@@ -0,0 +1,93 @@
+\name{getSymbols.yahooj}
+\alias{getSymbols.yahooj}
+\title{ Download OHLC Data From Yahoo! Japan Finance }
+\description{
+Downloads \code{Symbols} to specified \code{env}
+from \sQuote{finance.yahoo.co.jp}.  This method is
+not to be called directly, instead a call to
+\code{getSymbols(Symbols,src='yahooj')} will in
+turn call this method. It is documented for the
+sole purpose of highlighting the arguments
+accepted, and to serve as a guide to creating
+additional getSymbols \sQuote{methods}.
+}
+\usage{
+getSymbols.yahooj(Symbols,
+                  env,
+                  return.class = 'xts',
+                  index.class  = 'Date',
+                  from = "2007-01-01",
+                  to = Sys.Date(),
+                   ...)
+}
+\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}{ class of returned object }  
+       \item{index.class}{ class of returned object index (xts only) }  
+       \item{from}{ Retrieve data no earlier than this date. 
+                    (2007-01-01)}
+       \item{to}{ Retrieve data through this date (Sys.Date())}
+       \item{\dots}{ additional parameters }
+}
+\details{
+Meant to be called internally by \code{getSymbols} (see also).
+
+One of the few currently defined methods for loading
+data for use with \pkg{quantmod}.  Essentially a
+simple wrapper to the underlying Yahoo! Japan finance site's
+historical data download.
+
+The string \sQuote{YJ} will be prepended to the \code{Symbols} because
+Japanese ticker symbols usually start with a number and it is cumbersome
+to use variable names that start with a number in the R environment.
+
+It is recommended to prepend the ticker symbols with \sQuote{YJ} yourself
+if you use \code{setSymbolLookup}. That will make it possible for the main
+\code{getSymbols} function to find the symbols in the lookup table.
+}
+\value{
+A call to getSymbols.yahooj will load into the specified
+environment one object for each
+\code{Symbol} specified, with class defined 
+by \code{return.class}. Presently this may be \code{ts},
+\code{its}, \code{zoo}, \code{xts}, or \code{timeSeries}.
+
+In the case of xts objects, the indexing will be by Date. This
+can be altered with the \code{index.class} argument.  See
+\code{indexClass} for more information on changing index classes.
+}
+\references{ Yahoo! Japan Finance: \url{http://finance.yahoo.co.jp} }
+\author{ Wouter Thielen }
+\seealso{ \code{\link{getSymbols}},
+          \code{\link{setSymbolLookup}} }
+\examples{
+\dontrun{
+# All 4 getSymbols calls return the same
+# Sony (6758.T) OHLC to the global environment
+# The last example is what NOT to do!
+
+## Method #1
+getSymbols('6758.T',src='yahooj')
+
+
+## Method #2
+getSymbols('YJ6758.T',src='yahooj')
+
+
+## Method #3
+setDefaults(getSymbols,src='yahooj')
+  # OR
+setSymbolLookup(YJ6758.T='yahooj')
+
+getSymbols('YJ6758.T')
+
+#########################################
+##  NOT RECOMMENDED!!!
+#########################################
+## Method #4
+getSymbols.yahooj('6758.T',env=globalenv())
+}
+}
+\keyword{ data }

Modified: pkg/man/quantmod-package.Rd
===================================================================
--- pkg/man/quantmod-package.Rd	2014-12-12 17:14:13 UTC (rev 623)
+++ pkg/man/quantmod-package.Rd	2014-12-13 00:52:16 UTC (rev 624)
@@ -16,7 +16,7 @@
 Version: \tab 0.4-3\cr
 Date: \tab 2014-12-08\cr
 Depends: \tab xts(>= 0.9-0),zoo,TTR(>= 0.2),methods\cr
-Suggests: \tab DBI,RMySQL,RSQLite,timeSeries,its\cr
+Suggests: \tab DBI,RMySQL,RSQLite,timeSeries,its,XML\cr
 LazyLoad: \tab yes\cr
 License: \tab GPL-3\cr
 URL: \tab http://www.quantmod.com\cr



More information about the Quantmod-commits mailing list