[Blotter-commits] r834 - in pkg/FinancialInstrument: . inst inst/parser sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 5 15:06:39 CET 2011
Author: braverock
Date: 2011-11-05 15:06:39 +0100 (Sat, 05 Nov 2011)
New Revision: 834
Added:
pkg/FinancialInstrument/inst/
pkg/FinancialInstrument/inst/parser/
pkg/FinancialInstrument/inst/parser/DJIA.index.R
pkg/FinancialInstrument/inst/parser/ISO.currencies.wiki.R
pkg/FinancialInstrument/inst/parser/TRTH_BackFill.R
pkg/FinancialInstrument/inst/parser/calc.GS10TR.R
pkg/FinancialInstrument/inst/parser/define.index.components.yahoo.R
pkg/FinancialInstrument/inst/parser/download.DJUBSindex.R
pkg/FinancialInstrument/inst/parser/download.MorningstarCLSIndex.R
pkg/FinancialInstrument/inst/parser/download.NAREIT.R
pkg/FinancialInstrument/inst/parser/download.goldPrices.R
pkg/FinancialInstrument/inst/parser/download.pitrader.R
pkg/FinancialInstrument/inst/parser/download.tblox.R
pkg/FinancialInstrument/inst/parser/parse.EODdata.R
pkg/FinancialInstrument/inst/parser/parse.MSCI.R
pkg/FinancialInstrument/inst/parser/parse.Morningstar.R
pkg/FinancialInstrument/inst/parser/parse.SP500TR.R
Removed:
pkg/FinancialInstrument/sandbox/DJIA.index.R
pkg/FinancialInstrument/sandbox/ISO.currencies.wiki.R
pkg/FinancialInstrument/sandbox/TRTH_BackFill.R
pkg/FinancialInstrument/sandbox/calc.GS10TR.R
pkg/FinancialInstrument/sandbox/define.index.components.yahoo.R
pkg/FinancialInstrument/sandbox/download.DJUBSindex.R
pkg/FinancialInstrument/sandbox/download.MorningstarCLSIndex.R
pkg/FinancialInstrument/sandbox/download.NAREIT.R
pkg/FinancialInstrument/sandbox/download.goldPrices.R
pkg/FinancialInstrument/sandbox/download.pitrader.R
pkg/FinancialInstrument/sandbox/download.tblox.R
pkg/FinancialInstrument/sandbox/parse.EODdata.R
pkg/FinancialInstrument/sandbox/parse.MSCI.R
pkg/FinancialInstrument/sandbox/parse.Morningstar.R
pkg/FinancialInstrument/sandbox/parse.SP500TR.R
Modified:
pkg/FinancialInstrument/DESCRIPTION
Log:
- move all downlaod and parse files to inst/parser so they will be included with the package
- bump version
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2011-11-05 13:59:21 UTC (rev 833)
+++ pkg/FinancialInstrument/DESCRIPTION 2011-11-05 14:06:39 UTC (rev 834)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.8
+Version: 0.9
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
Copied: pkg/FinancialInstrument/inst/parser/DJIA.index.R (from rev 829, pkg/FinancialInstrument/sandbox/DJIA.index.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/DJIA.index.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/DJIA.index.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,34 @@
+#' get the components of the Dow Jones Industrial Average
+#'
+#' download a data.frame of the 30 Dow Jones components.
+#' @return 30 by 5 data.frame with columns \sQuote{Symbol}, \sQuote{Name}, \sQuote{Last.Trade}, \sQuote{Change}, \sQuote{Volume}
+#' @references \url{'http://finance.yahoo.com/q/cp?s=^DJI+Components'}
+DJIcomponents <- function() {
+ if (!("package:XML" %in% search() || require("XML",quietly=TRUE))) {
+ stop("Please install the XML package before using this function.")
+ }
+ djicomp <- readHTMLTable('http://finance.yahoo.com/q/cp?s=^DJI+Components')
+ data.frame(djicomp[[10]])
+}
+
+#' fetch the current divisor for the Dow Jones Industrial Average from Barrons
+#' @return numeric
+#' @references \url{'http://online.barrons.com/mdc/public/page/9_3022-djiahourly.html?mod=mdc_h_usshl'}
+dow.divisor <- function() {
+ wp <- readLines('http://online.barrons.com/mdc/public/page/9_3022-djiahourly.html?mod=mdc_h_usshl')
+ #wp2 <- wp[grep("30 INDUSTRIALS:",wp)]
+ #as.numeric(gsub(')</td>','',strsplit(wp2, 'divisor: ')[[1]][2]))
+ as.numeric(gsub(')</td>','',strsplit(wp[grep("30 INDUSTRIALS:",wp)], 'divisor: ')[[1]][2]))
+}
+
+currency('USD')
+DJIA.members <- sapply(DJIcomponents()$Symbol, stock, currency="USD", member.of='DJIA')
+getSymbols(DJIA.members) # <-- getting data first is not required, but may be preferable
+synthetic.instrument("DJIA","USD", members=DJIA.members, memberratio=rep(1,length(DJIA.members)),
+ multiplier=1/dow.divisor(), tick_size=0.01, description='Dow Jones Industrial Average')
+buildBasket('DJIA') #theoretical index
+tail(DJIA)
+
+getSymbols("^DJI") #acual index
+tail(DJI)
+
Copied: pkg/FinancialInstrument/inst/parser/ISO.currencies.wiki.R (from rev 829, pkg/FinancialInstrument/sandbox/ISO.currencies.wiki.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/ISO.currencies.wiki.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/ISO.currencies.wiki.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,93 @@
+#' Define currencies using the tables found on oanda's website.
+#'
+#' If you do not provide \code{Symbols} all oanda curriencies will be defined.
+#' If you do provide \code{Symbols} only the Symbols you provided will be defined.
+#' @param Symbols
+#' @param silent
+#' @return the names of the currecies that were defined. Called for side-effect
+#' @references \url{http://www.oanda.com/help/currency-iso-code}
+#' @author Garrett See
+#' @examples
+#' \dontrun{
+#' define_currencies.oanda(c("EUR","GBP","JPY"))
+#' define_currencies.oanda()
+#' }
+define_currencies.oanda <- function(Symbols, silent=FALSE) {
+ if (!("package:XML" %in% search() || require("XML",quietly=TRUE)))
+ stop("Please install the XML package before using this function.")
+ x <- readHTMLTable("http://www.oanda.com/help/currency-iso-code")
+ x <- lapply(x, function(xx) xx[-1,])
+ #all.syms <- unname(do.call(c,lapply(x, function(xx) as.character(xx[,1]))))
+ df <- do.call(rbind, lapply(x, function(xx) cbind(as.character(xx[,1]), as.character(xx[,2]))))
+ if(missing(Symbols)) Symbols <- df[,1]
+ df <- df[df[,1] %in% Symbols,]
+ apply(df,1,function(X) currency(X[1], description=X[2],defined.by='oanda'))
+}
+
+
+#http://en.wikipedia.org/wiki/ISO_4217#Active_codes
+
+#' Define currency instruments using the tables found on the ISO_4217 wikipedia page
+#'
+#' If you do not provide \code{Symbols} all active ISO 4127 curriencies will be defined.
+#' If you do provide \code{Symbols} only the Symbols you provided will be defined. Also,
+#' if you provide some \code{Symbols} that are not active ISO currencies, it will try to
+#' find them in the "Without currency code" and "Historic currency codes" tables.
+#' @param Symbols
+#' @param silent
+#' @return the names of the currecies that were defined.
+#' If \code{Symbols} was provided, they will be in the order they were found (ISO, non-ISO, historic).
+#' Called for side-effect
+#' @references \url{http://en.wikipedia.org/wiki/ISO_4217}
+#' @examples
+#' \dontrun{
+#' define_currencies.wiki(c("USD","EUR","ADP","ETB","GBP","BTC"))
+#' define_currencies.wiki()
+#' }
+define_currencies.wiki <- function(Symbols, silent=FALSE) {
+ if (!("package:XML" %in% search() || require("XML",quietly=TRUE)))
+ stop("Please install the XML package before using this function.")
+ x <- readHTMLTable("http://en.wikipedia.org/wiki/ISO_4217")
+ #"The following is a list of active codes of official ISO 4217 currency names."
+ ccy <- x[[2]] #active ISO 4217 currencies
+ if (!missing(Symbols)) {
+ ccy <- rbind(ccy, x[[3]]) #add non-ISO... things like Bitcoin
+ ccy <- ccy[ccy$Code %in% Symbols,]
+ } else Symbols <- NULL
+ out <- unname(apply(ccy, 1, function(xx) currency(xx[1], identifiers=list(Num=xx[2]), digits.after.dec=xx[3],
+ description=xx[4], country=xx[5], defined.by='wiki')))
+ if (!is.null(Symbols) && !identical(character(0), Symbols[!Symbols %in% ccy$Code])) {
+ if (!silent) warning(paste("The following are historical,",
+ "and are no longer active:", Symbols[!Symbols %in% ccy$Code]))
+ hccy <- x[[4]]
+ hccy <- hccy[hccy$Code %in% Symbols,]
+ out <- c(out, unname(apply(hccy, 1, function(xx) {
+ currency(xx[1], description=xx[4], used.from=xx[5], used.until=xx[6], replaced.by=xx[7], defined.by='wiki')
+ })))
+ }
+ out
+}
+
+#rm_currencies()
+#define_currencies.wiki(c("USD","XAU"))
+#exchange_rate("XAUUSD",src=list(src='oanda',name='XAU/USD'))
+
+#define_currencies.wiki(c("JPY","EUR","ADP","ETB","GBP","BTC"))
+#define_currencies.wiki()
+
+#_______________________________________________________________________________________
+
+#x <- readHTMLTable("http://en.wikipedia.org/wiki/ISO_4217")
+
+#"A number of territories are not included in ISO 4217, because their currencies are:
+#(a) not per se an independent currency but a variant of another currency,
+#(b) a legal tender only issued as commemorative banknotes or coinage, or
+#(c) a currency of an unrecognized or partially recognized state. These currencies are:"
+#nonISO.ccy <- x[[3]]
+
+#"A number of currencies were official ISO 4217 currency codes and currency names
+#until their replacement by the euro or other currencies.
+#The table below shows the ISO currency codes of former currencies and their common names
+#(which do not always match the ISO 4217 name)."
+#historic.ccy <- x[[4]]
+
Copied: pkg/FinancialInstrument/inst/parser/TRTH_BackFill.R (from rev 833, pkg/FinancialInstrument/sandbox/TRTH_BackFill.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/TRTH_BackFill.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/TRTH_BackFill.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,399 @@
+##############################################################################
+# Reuters Backfill Configuration Parameters #
+##############################################################################
+#
+# You should create a configuration file that includes the following
+#
+#instrument_file <- '/full/path/to/instruments.rda' #where your instrument metadata is stored
+#
+#archive_dir <- "/full/path/to/archives/" # where the split CSV, job reports, and gz files will be stored
+#path.output <- "/full/path/to/output/" # root dir where the .rda files for the xts will be placed
+#
+#job.name <- "mybackfill" # the Reuters TRTH job name
+#
+#username <- "username" #TRTH user name, usually your email address
+#password <- "password" #TRTH password
+#image <- TRUE
+#default_type='future_series'
+#default_type='guaranteed_spread'
+#
+#email_to <- 'someuser at somehost.com'
+#email_from <- 'someuser at somehost.com'
+#
+#no.cores <- 1 # for foreach
+##############################################################################
+config_file<-'TRTH_config_file.R'
+source(config_file)
+
+load(instrument_file)
+
+Sys.umask("0002")
+
+options(width=200)
+Date <- Sys.Date()
+
+require(xts)
+require(quantmod)
+require(FinancialInstrument)
+require(doMC)
+#require(sendmailR) # for email on failure
+#error.codes<-read.csv('curl.errors.csv',stringsAsFactors=FALSE,header=TRUE,row.names=1)
+
+registerDoMC(no.cores)
+# registerDoSEQ()
+
+Archive.output <- list.files(archive_dir)
+Archive.output <- Archive.output[grep(".gz",Archive.output)]
+Archive.output <- Archive.output[-c(grep("confirmation",Archive.output),grep("report",Archive.output))]
+
+listflag=FALSE
+while(!listflag)#try to download file list
+{
+ clear<-warnings() #currency loads from oanda alway generate warnings, clear them out
+ Reuters <- system(paste("curl ftp://tickhistory-ftp.thomsonreuters.com:15500/results/ -u ",username,":",password," --ftp-ssl -k -l",sep=""),intern=TRUE)
+ w<-''
+ w<-warnings()
+ if(!as.logical(length(Reuters)) || isTRUE(grep('curl',names(w))))
+ {
+ tmpmsg<-paste("curl returned error code", names(w),'\n','while attempting to download file list','\n','script will wait and retry in 30 min')
+ #sendmail(email_to,email_from,"error downloading Reuters file list",msg=tmpmsg)
+ Sys.sleep(180)
+ } else listflag=TRUE
+
+}
+
+# now we're past the while loop, so we have a file list
+Reuters.report <- Reuters[grep("report",Reuters)]
+Reuters.output <- Reuters[-c(grep("report",Reuters),grep("confirmation",Reuters))]
+Reuters.output <- Reuters.output[grep(job.name,Reuters.output)]
+
+Reuters.new <- Reuters.output[!(Reuters.output %in% Archive.output)]
+
+# or to start from the file list
+# Reuters.output <- Archive.output[grep(job.name,Archive.output)]
+# Reuters.new <- Reuters.output
+
+
+for(i in 1:length(Reuters.new))
+{
+ filename.gz <- Reuters.new[i]
+ filename.csv <- substr(filename.gz,1,(nchar(filename.gz)-3))
+
+ alias <- unlist(strsplit(filename.gz,"-"))[3]
+ alias <- unlist(strsplit(alias,".csv.gz"))
+
+ ## Download New Datasets
+ print(paste("Downloading ",filename.gz,sep=""))
+ fileflag=FALSE
+ while(!fileflag) #try to download individual files
+ {
+ Reuters2<-system(paste("curl -m 10800 --max-filesize 1610612736 ftp://tickhistory-ftp.thomsonreuters.com:15500/results/",filename.gz, " -u ",username,":",password," --ftp-ssl -k > ",archive_dir,"/",filename.gz,sep=""))
+ if(Reuters2!=0)
+ {
+ w2<-''
+ w2<-warnings()
+ tmpmsg<-paste("curl returned error code", Reuters2,"\n",w2,'\n','while attempting to download',filename.gz,'\n','will wait and retry in 10 min')
+ #sendmail(email_to,email_from,paste("error downloading Reuters file",filename.gz),msg=tmpmsg)
+ Sys.sleep(600)
+ } else fileflag=TRUE
+ }
+
+ ## Download Report s
+ system(paste("curl ftp://tickhistory-ftp.thomsonreuters.com:15500/results/",Reuters.report[grep(alias,Reuters.report)], " -u ",username,":",password," --ftp-ssl -k > ",archive_dir,"/",Reuters.report[grep(alias,Reuters.report)],sep=""))
+ system(paste("gzip -d -f ",archive_dir,"Report/",Reuters.report[grep(alias,Reuters.report)],sep=""))
+
+}
+
+## now unzip, split, rezip
+setwd(archive_dir)
+#foreach(j=1:length(Reuters.new)) %dopar%
+for(j in 1:length(Reuters.new))
+{
+
+ # system(paste("split --lines=10000000 -d ",filename.csv," split.",sep=""))
+ # files.split <- list.files("/home/mktdata/ReutersData/Archives", pattern="split.")
+
+ filename.gz <- Reuters.new[j]
+ filename.csv <- substr(filename.gz,1,(nchar(filename.gz)-3))
+
+ #unzip the file
+ print(paste("unzipping ",filename.gz, sep=""))
+ system(paste("gzip -d -f ",archive_dir,'/',filename.gz,sep=""))
+
+ alias <- unlist(strsplit(filename.gz,"-"))[3]
+ alias <- unlist(strsplit(alias,".csv.gz"))
+
+ ## Split the Files
+ ## command line awkstring would look like this:
+ #awk -F "," '{print >>$1"."$2".csv"}' sourcefile.csv
+ #
+ ## modified to deal with 'too many open files', thanks to Josh Ulrich
+ # awk -v f2="" -F "," '{
+ # f1 = $1"."$2".csv";
+ # print >> f1;
+ # if(f1 != f2) {
+ # close(f2);
+ # f2=f1;
+ # }
+ # }' sourcefile.csv
+ ## NOTE: if you get errors on 'too many open files' from awk, you'll need to adjust ulimit/nolimit
+ print(paste("Splitting ",filename.csv,sep=""))
+ #system(paste('awk -F "," ',"'{print >> $1", '"."$2".csv','"}',"' ",filename.csv, sep=""))
+ system(paste('awk -v f2="" -F "," '," '",'{
+ f1 = $1"."$2".csv";
+ print >> f1;
+ if(f1 != f2) {
+ close(f2);
+ f2=f1;
+ }
+ }',"' ",filename.csv, sep="")) #Improved awk w/ file close thanks to Josh Ulrich
+ ## Zip the File
+ print(paste("zipping ",filename.csv,sep=""))
+ system(paste("gzip -f ",archive_dir,'/',filename.csv,sep=""))
+
+}
+
+
+
+files.csv <- list.files(archive_dir)
+files.csv <- files.csv[-grep(".csv.gz",files.csv)]
+files.csv <- files.csv[grep(".csv",files.csv)]
+
+files.header <- files.csv[grep("RIC",files.csv)]
+files.csv <- files.csv[-grep("RIC",files.csv)]
+files.xts <- NULL
+
+for(k in 1:length(files.csv))
+{
+ #print(k)
+ name.csv <- files.csv[k]
+ name <- unlist(strsplit(name.csv,".",fixed=TRUE))[1]
+ RIC.date <- try(as.Date(unlist(strsplit(name.csv,".",fixed=TRUE))[2], format="%d-%b-%Y"))
+ date.format <- gsub("-",".",RIC.date)
+
+ if(weekdays(RIC.date)=="Saturday" | weekdays(RIC.date)=="Sunday")
+ {
+ file.remove(paste(archive_dir,name.csv,sep=""))
+ next
+
+ }
+
+ ## Handle leading digits and VIX and Cash
+ if(substr(name,1,1)==1){name.new <- substr(name,2,nchar(name));name.new <- make.names(name.new)}
+ else{name.new <- make.names(name)}
+
+ ## Does directory exist?
+ ex <- file.exists(paste(path.output,date.format,"/",sep=""))
+ if(ex != TRUE){dir.create(paste(path.output,date.format,"/",sep=""), mode="775")}
+
+ ## Move files to appropriate place
+ #system(paste("mv -f ", path.output,"Archives/",name.csv, " ", path.output,date.format,"/",date.format,".",name.new,".csv", sep=""))
+ system(paste("mv -f ", name.csv, " ", path.output,date.format,"/",date.format,".",name.new,".csv", sep=""))
+
+ print(paste(date.format, name.new, "moved", sep=" "))
+ files.xts <- rbind(files.xts,as.data.frame(cbind(name.new,date.format),stringsAsFactors=FALSE))
+
+}
+
+# now get instrument data
+files.xts$type<-rep(NA,nrow(files.xts))
+missing_i<-''
+instr_s<-unique(files.xts[,'name.new'])
+for(i in 1:length(instr_s)){
+ instr<-getInstrument(instr_s[i])
+ if(is.instrument(instr)){
+ files.xts[files.xts$name.new ==instr_s[i],]$type<-as.character(instr$type[1])
+ } else {
+ print(paste(instr_s[i], 'does not appear to be an instrument, setting it to', default_type))
+ files.xts[files.xts$name.new==instr_s[i],]$type<-default_type
+ missing_i<-c(missing_i,instr_s[i])
+ }
+}
+missing_i<-missing_i[-1]
+missing_i<-data.frame(symbol=missing_i,type=default_type)
+write.csv(missing_i,file=paste(archive_dir,'missing_instruments.CSV',sep=''))
+
+##If trying to fix a broken set:
+#files.csv<-'';for(dir in list.files(getwd(),pattern="20")) {files.csv<-c(files.csv,list.files(paste(getwd(),'/',dir,'/',sep=''),pattern=".csv"))}[-1]
+#files.xts<-NULL
+#for(l in 1:length(files.csv)) { rsplit<-as.vector(strsplit(files.csv[l],'.',fixed=TRUE)[[1]]); files.xts<-rbind(files.xts,cbind(rsplit[4],paste(rsplit[1],rsplit[2],rsplit[3],sep='.'))); print(files.xts[l,])}
+#colnames(files.xts)<-c('name.new','date.format')
+
+save(files.xts,file='files.xts.tmp.rda')
+
+H <- read.csv(paste(path.output,"Archives/#RIC.Date[G].csv",sep=""),header=FALSE,stringsAsFactors=FALSE)
+H <- H[nrow(H),]
+H <- make.names(H)
+
+## Into xts###############################################################
+reut2xts <- function( data, datapath, image=TRUE, overwrite=FALSE )
+{
+ prod <- data[,'name.new']
+ date <- data[,'date.format']
+ type <- data[,'type']
+
+ print(paste(date, prod, "xts", sep=" "))
+
+ RIC.code <- prod
+
+ file.name <- paste(datapath,"xts/",RIC.code,"/",date,".",RIC.code,".RData",sep="")
+ if(!isTRUE(overwrite) && file.exists(file.name)){
+ return(paste(file.name,"already exists, not overwriting"))
+ }
+
+ Data <- read.csv(paste(datapath,date,'/',date,'.',prod,'.csv',sep=''),stringsAsFactors=FALSE,header=FALSE)
+ names(Data) <- H
+
+ OTC.remove <- grep("IRGCOND",Data$Qualifiers)
+ OTC.remove <- c(OTC.remove,grep("High[USER]",Data$Qualifiers,fixed=TRUE))
+ OTC.remove <- c(OTC.remove,grep("Low[USER]",Data$Qualifiers,fixed=TRUE))
+
+ if(substr(prod,1,(nchar(prod)-2))=="ICF"){OTC.remove <- NULL}
+ if(substr(prod,1,(nchar(prod)-2))=="DOL"){OTC.remove <- NULL}
+ if(dim(Data)[1]<=25){return(NULL)}
+
+ index.new <- as.POSIXct(paste(Data$Date.G.,Data$Time.G,sep=" "),format="%d-%b-%Y%H:%M:%OS",tz="GMT")
+
+ ## Force Everything to numerics
+ Data <- Data[,c("Price","Volume","Bid.Price","Bid.Size","Ask.Price","Ask.Size")]
+ Data$Price <- as.numeric(Data$Price)
+ Data$Volume <- as.numeric(Data$Volume)
+ Data$Bid.Price <- as.numeric(Data$Bid.Price)
+ Data$Bid.Size <- as.numeric(Data$Bid.Size)
+ Data$Ask.Price <- as.numeric(Data$Ask.Price)
+ Data$Ask.Size <- as.numeric(Data$Ask.Size)
+
+ Data <- xts(Data,order.by=index.new,tz="GMT")
+
+ ## Remove block trades
+ if(length(OTC.remove)){Data <- Data[-OTC.remove]}
+
+ ## Turn bids/offers that are zero or less into NA for outrights
+
+ if(type !="guaranteed_spread")
+ {
+ Data$Bid.Price[Data$Bid.Price<=0,] <- NA
+ Data$Ask.Price[Data$Ask.Price<=0,] <- NA
+ Data$Price[Data$Ask.Price<=0,] <- NA
+ }else{
+ Data$Bid.Price[Data$Bid.Price==0,] <- NA
+ Data$Ask.Price[Data$Ask.Price==0,] <- NA
+ Data$Price[Data$Ask.Price==0,] <- NA
+ }
+
+ ## Carry last bid/offer forward
+
+ Data$Bid.Price <- na.locf(Data$Bid.Price)
+ Data$Ask.Price <- na.locf(Data$Ask.Price)
+
+ Data$Bid.Size <- na.locf(Data$Bid.Size)
+ Data$Ask.Size <- na.locf(Data$Ask.Size)
+
+ ## Remove Trades with Price or Volume of zero
+
+ Price.remove <- which(Data$Price == 0)
+ Volume.remove <- which(Data$Volume == 0)
+
+ if(length(c(Price.remove,Volume.remove))!=0)
+ {
+ Data <- Data[-c(Price.remove,Volume.remove)]
+ }
+ if(dim(Data)[1]<=25){return(NULL)}
+
+
+ ## Remove Price w/ Volume of NA and
+ ## Volume w/ Price of NA
+ na.remove <- c(which(!is.na(Data$Price) & is.na(Data$Volume)),
+ which(is.na(Data$Price) & !is.na(Data$Volume)))
+ if (length(na.remove)!=0) { Data <- Data[-sort(na.remove)] }
+
+ ## not enough rows
+ if(dim(Data)[1]<=10){return(NULL)}
+
+ ## Remove leading NAs on Bid/Ask
+ bid.remove <- which(is.na(Data$Bid.Price))
+ ask.remove <- which(is.na(Data$Ask.Price))
+ union.remove <- c(bid.remove,ask.remove)
+ if(length(union.remove)>0){Data <- Data[-union.remove]}
+
+ ## not enough rows
+ if(dim(Data)[1]<=25){return(NULL)}
+
+ ## Rename Data to RIC code
+ assign(RIC.code,Data)
+
+ ## Does xts directory exist?
+ ex <- file.exists(paste(datapath,"xts/",prod,"/",sep=""))
+ if(!ex){dir.create(paste(datapath,"xts/",prod,"/",sep=""),mode="775")}
+
+
+ file.name <- paste(datapath,"xts/",RIC.code,"/",date,".",RIC.code,".RData",sep="")
+ if(!isTRUE(overwrite) && file.exists(file.name)){
+ return(paste(file.name,"already exists, not overwriting"))
+ } else {
+ file.text <- paste("save(",RIC.code," ,file='",file.name,"')",sep="")
+ if(!file.exists(paste(datapath,"xts/",RIC.code,sep=""))){dir.create(paste(datapath,"xts/",RIC.code,sep=""),mode="775")}
+ eval(parse(text=file.text))
+ }
+
+ datarange <- range(index(Data),na.rm = TRUE)
+ datarange.dif <- difftime(datarange[2],datarange[1],units="secs")
+
+ if(isTRUE(image) && datarange.dif>3600)
+ {
+ ## Bid
+ if(!file.exists(paste(datapath,"xts/",RIC.code,"/Bid.Image/",sep=""))){dir.create(paste(datapath,"xts/",RIC.code,"/Bid.Image/",sep=""),mode="775")}
+ png(filename=paste(datapath,"xts/",RIC.code,"/Bid.Image/",date,".",RIC.code,".png",sep=""),width=1500,height=1000)
+ try(chartSeries(to.minutes(Data$Bid.Price,1),type="bar"),silent=TRUE)
+ dev.off()
+
+ file.copy(paste(datapath,"xts/",RIC.code,"/Bid.Image/",date,".",RIC.code,".png",sep=""),paste(datapath,"Archives/Bid.Image.tmp/",date,".",RIC.code,".png",sep=""))
+
+ ## Ask
+ if(!file.exists(paste(datapath,"xts/",RIC.code,"/Ask.Image/",sep=""))){dir.create(paste(datapath,"xts/",RIC.code,"/Ask.Image/",sep=""),mode="775")}
+ png(paste(datapath,"xts/",RIC.code,"/Ask.Image/",date,".",RIC.code,".png",sep=""),width=1500,height=1000)
+ try(chartSeries(to.minutes(Data$Ask.Price,1),type="bar"),silent=TRUE)
+ dev.off()
+
+ file.copy(paste(datapath,"xts/",RIC.code,"/Ask.Image/",date,".",RIC.code,".png",sep=""),paste(datapath,"Archives/Ask.Image.tmp/",date,".",RIC.code,".png",sep=""))
+
+ ## Price
+ Data.1 <- Data[!is.na(Data$Price),]
+ if(dim(Data.1)[1]>50)
+ {
+ if(!file.exists(paste(datapath,"xts/",RIC.code,"/Price.Image/",sep=""))){dir.create(paste(datapath,"xts/",RIC.code,"/Price.Image/",sep=""),mode="775")}
+ png(paste(datapath,"xts/",RIC.code,"/Price.Image/",date,".",RIC.code,".png",sep=""),width=1500,height=1000)
+ try(chartSeries(to.minutes(na.omit(Data$Price),1),type="bar"),silent=TRUE)
+ dev.off()
+
+ file.copy(paste(datapath,"xts/",RIC.code,"/Price.Image/",date,".",RIC.code,".png",sep=""),paste(datapath,"Archives/Price.Image.tmp/",date,".",RIC.code,".png",sep=""))
+ }
+ }
+
+ rm(list = paste(RIC.code,sep=""))
+
+} ## End fn reut2xts
+
+Out <- foreach(ii=iter(1:nrow(files.xts)),.errorhandling='pass') %dopar% reut2xts(files.xts[ii,,drop=FALSE],datapath=path.output, image=image)
+
+# now clean up
+files.rm <- list.files(archive_dir)
+files.rm <- files.rm[-grep(".csv.gz",files.rm)]
+files.rm <- files.rm[grep(".csv",files.rm)]
+file.remove(files.rm)
+file.remove('files.xts.tmp.rda')
+
+rm(missing_i)
+rm(Out)
+
+###############################################################################
+# Copyright (c) 2009-2011
+# Peter Carl, Brian G. Peterson, Lance Levenson
+#
+# This code is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id$
+#
+###############################################################################
+
Copied: pkg/FinancialInstrument/inst/parser/calc.GS10TR.R (from rev 829, pkg/FinancialInstrument/sandbox/calc.GS10TR.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/calc.GS10TR.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/calc.GS10TR.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,66 @@
+# Use yields of the Constant Maturity 10 year bond series from FRED
+# to calculate total returns.
+
+# Peter Carl
+
+# Originally described by Kenton Russell at his blog TimelyPortfolio,
+# posted April 15, 2011
+# http://timelyportfolio.blogspot.com/2011/04/historical-sources-of-bond-returns_17.html
+#
+
+require(quantmod)
+require(PerformanceAnalytics)
+require(RQuantLib)
+
+# Set the working directory.
+filesroot = "~/Data/FRED"
+
+# Create and set the working directory if it doesn't exist
+if (!file.exists(filesroot))
+ dir.create(filesroot, mode="0777")
+
+if (!file.exists(paste(filesroot, "/GS10TR.IDX", sep="")))
+ dir.create(paste(filesroot, "/GS10TR.IDX", sep=""), mode="0777")
+
+getSymbols("GS10", src="FRED") #load US Treasury 10y yields from FRED
+
+# Dates should be end of month, not beginning of the month as reported
+index(GS10) = as.Date(as.yearmon(index(GS10)), frac=1)
+
+# @TODO: Do this calculation with a longer list of symbols
+
+x.pr <- GS10 #set this up to hold price returns
+x.pr[1,1] <- 0
+colnames(x.pr) <- "Price Return"
+for (i in 1:(NROW(GS10)-1)) {
+ x.pr[i+1,1] <- FixedRateBondPriceByYield(yield=GS10[i+1,1]/100, issueDate=Sys.Date(), maturityDate=advance("UnitedStates/GovernmentBond", Sys.Date(), 10, 3), rates=GS10[i,1]/100,period=2)[1]/100-1
+}
+#total return will be the price return + yield/12 for one month
+x.tr <- x.pr + lag(GS10,k=1)/12/100
+colnames(x.tr)<-"Total Return"
+
+# Add an index column labeled "Close"
+x.idx = 100*cumprod(1+na.omit(x.tr))
+x.xts = cbind(x.idx, x.tr)
+x.xts[1,1]=100 # base the index at 100
+colnames(x.xts) = c("Close", "Return")
+
+# Save it into an rda file on the filesystem
+save(x.xts, file=paste(filesroot,"GS10TR.IDX/GS10TR.IDX.rda", sep="/"))
+
+# Create currencies first:
+require(FinancialInstrument)
+currency("USD")
+
+# Describe the metadata for the index
+instrument("GS10TR.IDX", currency="USD", multiplier=1, tick_size=.01, start_date="1953-04-01", description="US 10Y Constant Maturity Total Returns", data="CR", source="fred", assign_i=TRUE)
+
+# Now, whenever you log in you need to register the instruments. This
+# might be a line you put into .Rprofile so that it happens automatically:
+# require(quantmod) # this requires a development build after revision 560 or so.
+setSymbolLookup.FI(base_dir=filesroot, split_method='common')
+
+# Now you should be able to:
+getSymbols("GS10TR.IDX")
+chartSeries(Cl(GS10TR.IDX), theme="white")
+head(GS10TR.IDX)
Copied: pkg/FinancialInstrument/inst/parser/define.index.components.yahoo.R (from rev 829, pkg/FinancialInstrument/sandbox/define.index.components.yahoo.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/define.index.components.yahoo.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/define.index.components.yahoo.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,55 @@
+
+#' Define an Index and it's components using yahoo
+#'
+#' Get the components of an index and define instruments
+#' @param Symbol character yahoo ticker symbol for a stock index (e.g. "^DJI" or "^GDAXI")
+#' @param currency
+#' @return called for side-effect, but it will return a list with 2 components:
+#' \item{synthetic}{name of the \code{\link{synthetic}} instrument that was defined to hold the metadata of the index.}
+#' \item{stock}{name of the component \code{\link{stock}}s that were defined}
+#' @note Depends on XML package
+#' @author Garrett See
+#' @examples
+#' \dontrun{
+#' define_components.yahoo('^STOXX50E', 'EUR')
+#' define_components.yahoo('^DJI', 'USD')
+#' }
+define_components.yahoo <- function(Symbol, currency) {
+ require(FinancialInstrument)
+ require(XML)
+ ccy <- currency(currency) #make sure it's defined
+ x <- readHTMLTable(paste("http://finance.yahoo.com/q/cp?s=",Symbol,"+Components", sep=""))
+ mdata <- x[which.max(sapply(x, NROW))][[1]][,1:2]
+ new.Symbol <- synthetic(Symbol, ccy, members=paste(mdata[,1]), src=list(src='yahoo',name=Symbol), identifiers=list(yahoo=Symbol))
+ if (!identical(integer(0), grep("There is no Components data", mdata[,1]))) stop("No Components Data Available for ", Symbol)
+ stks <- rep(NA_character_, NROW(mdata))
+ for (i in 1:NROW(mdata)) {
+ tmpsym <- paste(mdata[i,1])
+ stks[i] <- stock(tmpsym, currency=ccy, Name=paste(mdata[i,2]), member.of=new.Symbol)
+ if (!identical(tmpsym,stks[i])) {
+ # add info about how to find data and metadata
+ instrument_attr(stks[i], 'src', list(src='yahoo', name=tmpsym))
+ instrument_attr(stks[i], 'identifiers', list(yahoo=tmpsym))
+ }
+ }
+ list(synthetic=new.Symbol, stock=stks)
+}
+
+#define_components.yahoo('^STOXX50E','EUR')
+#Symbol <- '^STOXX50E'
+#instr <- getInstrument("^STOXX50E")
+#instr
+#memb5 <- getInstrument(instr$members[5])
+#memb5
+#getInstrument(memb5$member.of)
+
+
+#define_components.yahoo("^GDAXI","EUR")
+#getSymbols("X63DU.DE")
+#getSymbols("63DU.DE")
+#getInstrument("X63DU.DE")
+#getInstrument("63DU.DE")
+
+
+
+
Copied: pkg/FinancialInstrument/inst/parser/download.DJUBSindex.R (from rev 829, pkg/FinancialInstrument/sandbox/download.DJUBSindex.R)
===================================================================
--- pkg/FinancialInstrument/inst/parser/download.DJUBSindex.R (rev 0)
+++ pkg/FinancialInstrument/inst/parser/download.DJUBSindex.R 2011-11-05 14:06:39 UTC (rev 834)
@@ -0,0 +1,153 @@
+download.DJUBS <- function (filesroot = "~/Data/DJUBS") {
+ # Script for parsing DJUBS index daily price data series from the
+ # DJ website.
+
+ # Peter Carl
+
+ # DETAILS
+ # Parse index close prices from the spreadsheet containing the full series:
+ # http://www.djindexes.com/mdsidx/downloads/xlspages/ubsci/DJUBS_full_hist.xls
+
+
+ # Several series, all index values
+ # Remove the footer at the bottom
+ # Load needed packages:
+ require(zoo)
+ require(gdata)
+ require(FinancialInstrument)
+ require(quantmod)
+ # filesroot: Set the working directory, where there's a .incoming folder that
+ # contains the downloaded spreadsheet.
+
+ # Create and set the working directory if it doesn't exist
+ if (!file.exists(filesroot))
+ dir.create(filesroot, mode="0777")
+
+ # Create and set the .incoming directory if it doesn't exist
+ if (!file.exists(paste(filesroot, "/.incoming", sep="")))
+ dir.create(paste(filesroot, "/.incoming", sep=""), mode="0777")
+ setwd(paste(filesroot, "/.incoming", sep=""))
+
+ # Remove the old file from .incoming
+ if(file.exists("DJUBS_full_hist.xls"))
+ system("rm DJUBS_full_hist.xls")
+
+ # Download the xls workbook directly from the web site:
+ print("Downloading excel spreadsheet from DJUBS web site...")
+ system("wget http://www.djindexes.com/mdsidx/downloads/xlspages/ubsci_public/DJUBS_full_hist.xls")
+
+ if(!file.exists("DJUBS_full_hist.xls"))
+ stop(paste("No spreadsheet exists. Download the spreadsheet to be processed from www.djindexes.com into ", filesroot, "/.incoming", sep=""))
+
+ sheetnames=c("Excess Return", "Total Return")
+ for(sheet in sheetnames){
+ print(paste("Reading", sheet, "sheet... This will take a moment..."))
+ x = read.xls("DJUBS_full_hist.xls", sheet=sheet)
+
+ # Add column names, get the descriptions to add as attributes
+ colnames(x)=t(as.data.frame(apply(x[2,], FUN=as.character, MARGIN=1), stringsAsFactors=FALSE))
+ x.attr = t(as.data.frame(x[1,], stringsAsFactors=FALSE))
+ x=x[-1:-2,]
+
+ # Get rid of the last line, which contains the disclaimer
+ x=x[-dim(x)[1],]
+ # Remove blank columns between sections
+ x=x[,-which(apply(x,2,function(x)all(is.na(x))))]
+
+ # Get attributes and labels
+ categoryNames = x.attr[,!is.na(x.attr)]
+ symbolNames = paste(make.names(colnames(x[,])), ".IDX", sep="")
+ symbolNamesMonthly = paste(make.names(colnames(x[,])), ".M.IDX", sep="")
+ ISOdates = as.Date(x[,1], "%m/%d/%Y")
+
+ for(i in 2:length(symbolNames)) {
+ # check to make sure directories exist for each symbol, first for daily series...
+ dir.create(paste(filesroot, symbolNames[i], sep="/"), showWarnings = FALSE,
+ recursive = FALSE, mode = "0777")
+ # ... then for monthly series
+ dir.create(paste(filesroot, symbolNamesMonthly[i], sep="/"), showWarnings = FALSE,
+ recursive = FALSE, mode = "0777")
+ }
+
+ # Parse the columns into individual price objects
+ print("Processing columns as symbols...")
+ for( i in 2:dim(x)[2]){
+ x.xts = as.xts(as.numeric(x[,i]), order.by=ISOdates)
+ R.xts = Return.calculate(x.xts)
+ x.xts = cbind(x.xts, R.xts)
+ colnames(x.xts)=c("Close", "Returns")
+ xtsAttributes(x.xts) <- list(Description = paste(categoryNames[,i], sheet, "Index"))
+
+ save(x.xts, file=paste(filesroot, symbolNames[i], paste(symbolNames[i], ".rda", sep=""), sep="/"))
+ print(paste(symbolNames[i],", ",categoryNames[,i], ", ", sheet, sep=""))
+
+ # Describe the metadata for each index
+ instrument(symbolNames[i], currency="USD", multiplier=1, tick_size=.01, start_date=head(index(x.xts),1), description=paste(categoryNames[,i], "Index"), data="CR", source="DJUBS", frequency="Daily", assign_i=TRUE)
+
+ # Construct a monthly series from the daily series
+ x.m.xts = to.monthly(Cl(x.xts))
+ x.m.xts = cbind(x.m.xts[,4], Return.calculate(x.m.xts[,4]))
+ colnames(x.m.xts)=c("Close","Returns")
+ # @ TODO Want to delete the last line off ONLY IF the month is incomplete
+ if(tail(index(x.xts),1) != as.Date(as.yearmon(tail(index(x.xts),1)), frac=1)) {
+ # That test isn't quite right, but its close. It won't work on the first
+ # day of a new month when the last business day wasn't the last day of
+ # the month. It will work for the second day.
+ x.m.xts = x.m.xts[-dim(x.m.xts)[1],]
+ }
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/blotter -r 834
More information about the Blotter-commits
mailing list