#################################################################################################################################
##BARCHART
"getSymbols.barchart" <-
function(Symbols,env,return.class='xts',index.class="Date",
from='2007-01-01',
to=Sys.Date(),
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
tmp <- tempfile()
on.exit(unlink(tmp))
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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])-1
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])-1
to.d <- as.numeric(strsplit(as.character(as.Date(to,origin='1970-01-01')),'-',)[[1]][3])
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")
if (nchar(from.m)==1) {from.m=paste0("0",from.m)}
if (nchar(from.d)==1) {from.d=paste0("0",from.d)}
if (nchar(to.m)==1) {to.m=paste0("0",to.m)}
if (nchar(to.d)==1) {to.d=paste0("0",to.d)}
download.file(paste0("http://marketdata.websol.barchart.com/getHistory.csv?key=6dd86c31689100c14a6b4f75f95fe28a&symbol=",
Symbols.name,
"&splits=1÷nds=1&type=daily",
"&startDate=",
from.y,from.m,from.d,
"&endDate=",
to.y,to.m,to.d)
,destfile=tmp,quiet=T)
fr <- read.csv(tmp)
fr = fr[,c(3,4,5,6,7,8,7)] #GETTING CORRECT COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED) *close=adjusted
fr <- xts(as.matrix(fr[,-1]),
as.Date(fr[,1]),
#as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
src='barchart',updated=Sys.time())
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
#ADJUST THE OHLC BASED ON THE ADJUSTED COLUMN
if(adjust) {fr <- adjustOHLC(fr, symbol.name=Symbols.name,use.Adjusted=T)}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
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)
}
# }}}
#################################################################################################################################
#################################################################################################################################
##QUOTEMEDIA WEB ONLY
"getSymbols.quotemediaweb" <-
function(Symbols,env,return.class='xts',index.class="Date",
from='1970-01-01',
to=Sys.Date(),
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
tmp <- tempfile()
on.exit(unlink(tmp))
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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])-1
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])-1
to.d <- as.numeric(strsplit(as.character(as.Date(to,origin='1970-01-01')),'-',)[[1]][3])
Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
if (from.y<1960) {from.y=1960}
urlval=paste0("https://app.quotemedia.com/quotetools/getHistoryDownload.csv?&webmasterId=501",
"&startDay=",from.d,
"&startMonth=",from.m,
"&startYear=",from.y,
"&endDay=",to.d,
"&endMonth=",to.m,
"&endYear=",to.y,
"&isRanged=true&",
"symbol=",Symbols.name)
download.file(urlval,destfile=tmp,quiet=T)
fr <- read.csv(tmp,na.strings="null")
if (nrow(fr)<=2) { #8 is to account for columns
urlval=paste0("https://app.quotemedia.com/quotetools/getHistoryDownload.csv?&webmasterId=501",
"&startDay=",startday,
"&startMonth=",startmonth,
"&startYear=",startyear,
"&endDay=",endday,
"&endMonth=",endmonth,
"&endYear=",endyear,
"&isRanged=true&",
"qm_symbol=",Symbols.name)
download.file(urlval,destfile=tmp,quiet=T)
fr <- read.csv(tmp,na.strings="null")
}
fr <- na.omit(fr[,c(1,2,3,4,5,9,9)]) #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED) *close=adjusted
frtemp = as.matrix(fr[,-1])
class(frtemp)<-"numeric"
tryCatch({
fr <- xts(frtemp,
t(as.Date(fr[,1])),
src='qmweb',updated=Sys.time())
}, error = function(e) {
print(e)
stop(paste('Problem running Back Test:', e))
})
rm(frtemp)
if (is.na(fr[1,6])) {fr[1,6]=0}
fr[, 6][is.na(fr[, 6])] <- fr[, 4]
#Symbols.name.new = gsub('\\:', '.', Symbols.name)
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
# Adjustment algorithm by Joshua Ulrich
#if(adjust) {fr <- adjustOHLC(fr, symbol.name=Symbols.name , use.Adjusted=T)}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
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(0.5)
}
}
if(auto.assign)
return(Symbols)
return(fr)
}
# }}}
#################################################################################################################################
#################################################################################################################################
##QUANDL
"getSymbols.quandl" <-
function(Symbols=NULL,env,return.class='xts',index.class="Date",
from='2007-01-01',
to=Sys.Date(),
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
quandl.URL <- "https://www.quandl.com/api/v3/datasets/"
quandl.databasetoaccess = "EOD"
tmp <- tempfile()
on.exit(unlink(tmp))
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
quandl.startdownload = paste0(from.y,"-",sprintf('%.2d',from.m),"-",sprintf('%.2d',from.d)) #EX: "2005-01-01"
quandl.enddownload = paste0(to.y,"-",sprintf('%.2d',to.m),"-",sprintf('%.2d',to.d)) #EX: "2016-01-01"
##Example: https://www.quandl.com/api/v3/datasets/EOD/MMM.csv?api_key=xxxxxx&start_date=1970-01-01&end_date=1970-01-01
quandl.symbol = Symbols.name
download.file(paste0(
quandl.URL,
quandl.databasetoaccess,"/",
quandl.symbol,".csv",
"?api_key=",quandl.apikey,
"&start_date=",quandl.startdownload,
"&end_date=",quandl.enddownload
),destfile=tmp,quiet=T)
fr <- read.csv(tmp)
fr <- xts(as.matrix(fr[,-1]),
as.Date(fr[,1]),
#as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
src='quandl',updated=Sys.time())
fr = fr[,c(1,2,3,4,5,11)] #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
if(adjust) {
# Adjustment algorithm by Joshua Ulrich
fr <- adjustOHLC(fr, symbol.name=Symbols.name , use.Adjusted=T)
}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
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)
# }
Sys.sleep(0.1)
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
#################################################################################################################################
##QUANDL - WIKI
"getSymbols.quandl_wiki" <-
function(Symbols=NULL,env,return.class='xts',index.class="Date",
from='2000-01-01',
to=Sys.Date(),quandl.apikey,
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
quandl.URL <- "https://www.quandl.com/api/v3/datatables/"
quandl.databasetoaccess = "WIKI"
tmp <- tempfile()
on.exit(unlink(tmp))
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
quandl.startdownload = paste0(from.y,"-",sprintf('%.2d',from.m),"-",sprintf('%.2d',from.d)) #EX: "2005-01-01"
quandl.enddownload = paste0(to.y,"-",sprintf('%.2d',to.m),"-",sprintf('%.2d',to.d)) #EX: "2016-01-01"
quandl.symbol = Symbols.name
# downloadfileurl = paste0(
# quandl.URL,
# quandl.databasetoaccess,"/PRICES?ticker=",
# quandl.symbol,
# "&qopts.export=true",
# "&api_key=",quandl.apikey
# )
#
# download.file(downloadfileurl,destfile=tmp,quiet=T)
#fr <- read.csv(unz(tmp))
library(Quandl)
Quandl.api_key(quandl.apikey)
fr <- Quandl(paste0('WIKI/',quandl.symbol),type="xts")
# fr <- xts(as.matrix(fr[,-1]),
# as.Date(fr[,1]),
# #as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
# src='quandl',updated=Sys.time())
fr = fr[,c(1,2,3,4,5,11)] #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
if(adjust) {
# Adjustment algorithm by Joshua Ulrich
fr <- adjustOHLC(fr, symbol.name=Symbols.name , use.Adjusted=T)
}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
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)
# }
Sys.sleep(0.1)
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
#################################################################################################################################
##QUANDL - UNIVERSAL
"getSymbols.quandl_mix" <-
function(Symbols=NULL,env,return.class='xts',index.class="Date",
from='2000-01-01',
to=Sys.Date(),quandl.apikey,
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
quandl.startdownload = paste0(from.y,"-",sprintf('%.2d',from.m),"-",sprintf('%.2d',from.d)) #EX: "2005-01-01"
quandl.enddownload = paste0(to.y,"-",sprintf('%.2d',to.m),"-",sprintf('%.2d',to.d)) #EX: "2016-01-01"
fr=0
library(Quandl)
Quandl.api_key(quandl.apikey)
try({
fr <- Quandl(paste0('EOD/',Symbols.name),type="xts")
fr = fr[,c(1,2,3,4,5,11)] #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
})
#if it is empty -- therefore could not find the symbol (TRY MUTUAL FUNDS AND INDEXES AT YAHOO)
if (fr==0) {
try({fr <- Quandl(paste0('YAHOO/FUND_',Symbols.name),type="xts")})
}
if (fr==0) {
try({fr <- Quandl(paste0('YAHOO/INDEX_',Symbols.name),type="xts")})
}
if (fr==0) {
try({fr <- Quandl(paste0('YAHOO/',Symbols.name),type="xts")})
}
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
#ADJUST THE OHLC BASED ON THE ADJUSTED COLUMN
if(adjust) {fr <- adjustOHLC(fr, symbol.name=Symbols.name,use.Adjusted=T)}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
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)
# }
Sys.sleep(0.1)
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
#################################################################################################################################
##MORNINGSTAR
##########################################################################################################################
#GROWTH DATA
get_morningstar_growthdata <- function(fundinfo,startdate,enddate)
{
growthdata=getURL(paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=getcc&secids=",
fundinfo,
"&dataid=117&startdate=",
startdate,
"&enddate=",
enddate,
"¤cy=&format=1&adjusment=-1&"))
try({if (growthdata=="null") {
cat("Growth Data Failed 1st Load (dataid=117")
growthdata=getURL(paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=getcc&secids=",
fundinfo,
"&dataid=8226&startdate=",
startdate,
"&enddate=",
enddate,
"¤cy=&format=1&adjusment=-1&"))
}})
growthdata <- gsub("NaN","\"NA\"",growthdata)
growthdata <- fromJSON(growthdata)
growthdata<-growthdata$data$r$t[[1]]
growthdata<-growthdata$d[[1]]
#PRICE DATA
fr<-as.data.frame(as.numeric(growthdata$v))
fr$Date<-as.Date(growthdata$i,origin="1899-12-30")
rm(growthdata)
fr <- xts(as.matrix(fr[,1]),
as.Date(fr[,2]),
#as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
src='morningstar',updated=Sys.time())
return(fr)
}
##########################################################################################################################
##########################################################################################################################
#OHLC (Price) DATA
get_morningstar_ohlcdata <- function(fundinfo,startdate,enddate)
{
ohlcdata=getURL(paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=getcc&secids=",
fundinfo,
"&dataid=8217&startdate=",
startdate,
"&enddate=",
enddate,
"¤cy=&format=1"))
try({if (ohlcdata=="null") {
cat("OHLC Data Failed 1st Load (dataid=8217")
ohlcdata=getURL(paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=getcc&secids=",
fundinfo,
"&dataid=8225&startdate=",
startdate,
"&enddate=",
enddate,
"¤cy=&format=1"))
}})
ohlcdata<-gsub("NaN","\"NA\"",ohlcdata)
ohlcdata <- fromJSON(ohlcdata)
ohlcdata<-ohlcdata$data$r$t[[1]]
ohlcdata<-ohlcdata$d[[1]]
#PRICE DATA
fr<-as.data.frame(as.numeric(ohlcdata$v))
fr$Date<-as.Date(ohlcdata$i,origin="1899-12-30")
rm(ohlcdata)
fr <- xts(as.matrix(fr[,1]),
as.Date(fr[,2]),
#as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
src='morningstar',updated=Sys.time())
return(fr)
}
##########################################################################################################################
##########################################################################################################################
#STOCK SID AND TYPE INFORMATION RETURN
get_morningstar_stockinfo <- function(myticker=NULL)
{
dir = "/home/shiny/" #CORRECT DIRECTORY FOR LINUX & SHINYAPPS.IO
if (file.exists(paste0(dir,myticker,"_sidtype.txt"))) { #GET FILE FROM CACHE
return(readLines(con=paste0(dir,myticker,"_sidtype.txt")))
}
else {
urldata=getURL(paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=gettid&symbol=",
myticker,
""))
urldata=fromJSON(urldata)
# sidval=urldata$Records$SID
# typeval=urldata$Records$Type
# rm(urldata)
return(paste0(urldata$Records$SID,";",urldata$Records$Type))
}
}
##########################################################################################################################
"getSymbols.morningstar" <-
function(Symbols=NULL,env,return.class='xts',index.class="Date",
from='2000-01-01',
to=Sys.Date(),
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
lenval=length(Symbols)
for(i in 1:lenval) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
startdate=paste0(from.y,"-",from.m,"-",from.d)
enddate=paste0(to.y,"-",to.m,"-",to.d)
#GETTING FUND SID AND TYPE
if (Symbols[[i]]=="_CASH") {
fundinfo=get_morningstar_stockinfo("VFINX") #USING VFINX AS THE CASH OPTION DATA DOWNLOAD SINCE IT HAS FULL HISTORY
fr=merge(get_morningstar_ohlcdata(fundinfo=fundinfo,startdate=startdate,enddate=enddate),get_morningstar_growthdata(fundinfo=fundinfo,startdate=startdate,enddate=enddate),all=TRUE)
fr[,1]=seq(from = 100, to = 100.1, length.out = length(fr[,1]))
fr = fr[,c(1,1,1,1,1,1)]
}
else {
fundinfo=get_morningstar_stockinfo(Symbols.name)
#MERGING GROWTH DATA WITH OHLC DATA (COLUMN 1 IS REGULAR CLOSE, COLUMN 2 IS ADJUSTED GROWTH VALUES)
fr=merge(get_morningstar_ohlcdata(fundinfo=fundinfo,startdate=startdate,enddate=enddate),get_morningstar_growthdata(fundinfo=fundinfo,startdate=startdate,enddate=enddate),all=TRUE)
#REMOVING ROWS WITH NA (NON TRADED DAYS)
fr=fr[!is.na(fr[,1])]
fr = fr[,c(1,1,1,1,1,2)] #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
}
colnames(fr) <- c('Open','High','Low','Close','Volume','Adjusted')
#ADJUST THE OHLC BASED ON THE ADJUSTED COLUMN
if(adjust) { fr <- adjustOHLC(fr, symbol.name=Symbols.name,use.Adjusted=T) }
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
if(auto.assign)
assign(Symbols[[i]],fr,env)
#DELAY BETWEEN LOADING NEW SYMBOL
if (lenval>4 && i<lenval-1) {Sys.sleep(1.0)}
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
# #################################################################################################################################
# ##TIINGO.COM [https://api.tiingo.com]
# `getSymbols.tiingo` <- function(Symbols,env,from='1960-01-02',to=Sys.Date(), adjust=T, return.class="xts",apikey="",index.class="Date", ...) {
#
# importDefaults("getSymbols.yahoo")
# 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
#
#
# for(i in 1:length(Symbols)) {
# Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
# Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
#
#
# # from <- getSymbolLookup()[[Symbols[[i]]]]$from
# # from <- if(is.null(from)) default.from else from
# # to <- getSymbolLookup()[[Symbols[[i]]]]$to
# # to <- if(is.null(to)) default.to else to
#
# 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])
#
#
# #GET FUND DESCRIPTION
# # fund.desc.url = paste0("https://api.tiingo.com/tiingo/daily/",tolower(myticker),"?token=",apikey)
# #
# # fund.desc = fromJSON(getURL(fund.desc.url))$name
#
# #GET FUND DATA
# fund.data.url = paste0("https://api.tiingo.com/tiingo/daily/",tolower(Symbols.name),"/prices?startDate=",from.y,"-",from.m,"-",from.d,"&endDate=",to.y,"-",to.m,"-",to.d,"&token=",apikey)
#
#
# fr <- fromJSON(getURL(fund.data.url))
#
#
# fr <- xts(fr[,-1],order.by=as.Date(fr[,1]),src='tiingo',updated=Sys.time())
#
#
# fr=fr[,c(4,2,3,1,5,6)] #GETTING CORRECT COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
#
# colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
# c('Open','High','Low','Close','Volume','Adjusted'),
# sep='.')
#
# if(adjust) {fr <- adjustOHLC(fr, symbol.name=Symbols.name , use.Adjusted=T)}
#
# fr <- convert.time.series(fr=fr,return.class=return.class)
# if(is.xts(fr))
# indexClass(fr) <- index.class
#
# if(auto.assign) {
# assign(Symbols[[i]],fr,env)
# }
#
# }
#
# if(auto.assign)
# return(Symbols)
# return(fr)
# }
# #################################################################################################################################
#################################################################################################################################
##poloniex.com CryptoCurrency Exchange [https://poloniex.com/support/api/]
`getSymbols.crypto` <- function(Symbols,env,from='1960-01-02',to=Sys.Date(), adjust=F, return.class="xts",apikey="",index.class="Date", ...) {
importDefaults("getSymbols.yahoo")
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
for(i in 1:length(Symbols)) {
Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
# from <- getSymbolLookup()[[Symbols[[i]]]]$from
# from <- if(is.null(from)) default.from else from
# to <- getSymbolLookup()[[Symbols[[i]]]]$to
# to <- if(is.null(to)) default.to else to
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])
datestart = as.numeric(as.POSIXct(paste0(from.y,"-",from.m,"-",from.d)))
dateend = as.numeric(as.POSIXct(paste0(to.y,"-",to.m,"-",to.d)))
#ex. https://poloniex.com/public?command=returnChartData¤cyPair=USDT_BTC&start=1517461200&end=1518670800&period=86400
#GET FUND DATA
if (Symbols[[i]]=="_CASH" || Symbols[[i]]=="CASH") {
fund.data.url = paste0("https://poloniex.com/public?command=returnChartData¤cyPair=","USDT_BTC","&start=",datestart,"&end=",dateend,"&period=86400")
}
else {
fund.data.url = paste0("https://poloniex.com/public?command=returnChartData¤cyPair=",toupper(Symbols.name),"&start=",datestart,"&end=",dateend,"&period=86400")
}
fr <- fromJSON(getURL(fund.data.url))
fr <- xts(fr[,-1],order.by=as.Date(as.POSIXct(fr[,1],origin="1970-01-01")),src='crypto',updated=Sys.time())
#NO INCREASE FOR _CASH
if (Symbols[[i]]=="_CASH" || Symbols[[i]]=="CASH") {
fr[,1]=seq(from = 100, to = 100.1, length.out = length(fr[,1]))
fr[,2]=fr[,1]
fr[,3]=fr[,1]
fr[,4]=fr[,1]
fr[,5]=fr[,1]
}
fr=fr[,c(3,1,2,4,5,4)] #GETTING CORRECT COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
colnames(fr) <- paste(toupper(gsub('\\^','',Symbols.name)),
c('Open','High','Low','Close','Volume','Adjusted'),
sep='.')
#if(adjust) {fr <- adjustOHLC(fr, symbol.name=Symbols.name , use.Adjusted=T)}
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
if(auto.assign) {
assign(Symbols[[i]],fr,env)
}
Sys.sleep(0.34)
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
#################################################################################################################################
##FRED - ST. LOUIS FED
`getSymbols.FRED_modified` <- function(Symbols,env, return.class="xts",apikey,index.class="Date", ...) {
importDefaults("getSymbols.yahoo")
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
for(i in 1:length(Symbols)) {
Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
urljsondata=fromJSON(
getURL(paste0("https://api.stlouisfed.org/fred/series/observations?series_id=",
Symbols.name,
"&api_key=",
apikey,
"&file_type=json"))
)$observations[,3:4]
fr<-as.data.frame(urljsondata)
rm(urljsondata)
matrixval=as.numeric(as.matrix(fr[,2]))
for (k in 1:length(matrixval)) {if (is.na(matrixval[k])) {matrixval[k]=matrixval[k-1]} } #FIXING MISSING VALUES
fr <- xts(matrixval,
as.Date(fr[,1]),
src='FRED',updated=Sys.time()) * 6.71359
rm(matrixval)
fr = fr[,c(1,1,1,1,1,1)]
colnames(fr) <- c('Open','High','Low','Close','Volume','Adjusted')
if(is.xts(fr))
indexClass(fr) <- index.class
if(auto.assign) {
assign(Symbols[[i]],fr,env)
}
}
if(auto.assign)
return(Symbols)
return(fr)
}
#################################################################################################################################
#################################################################################################################################
##MORNINGSTAR - HISTORICAL CATEGORIES
"getSymbols.morningstar_historical" <-
function(Symbols=NULL,env,return.class='xts',index.class="Date",
from='1900-01-02',
to=Sys.Date(),apikey,
...)
{
importDefaults("getSymbols.yahoo")
this.env <- environment()
for(var in names(list(...))) {
# import all named elements that are NON formals
assign(var, list(...)[[var]], this.env)
}
if(!hasArg(adjust))
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
for(i in 1:length(Symbols)) {
return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
return.class <- ifelse(is.null(return.class),default.return.class,
return.class)
from <- getSymbolLookup()[[Symbols[[i]]]]$from
from <- if(is.null(from)) default.from else from
to <- getSymbolLookup()[[Symbols[[i]]]]$to
to <- if(is.null(to)) default.to else to
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])
startdate=paste0(from.y,"-",from.m,"-",from.d)
enddate=paste0(to.y,"-",to.m,"-",to.d)
Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
fr=NULL
#TESTING IF I SHOULD GET DATA ELSEWHERE
if (Symbols.name=='US_REAL_ESTATE' || Symbols.name=='US_MICRO_CAP' || Symbols.name=='GOLD_BULLION') { #FRED
#GETTING FUND SID AND TYPE
fundinfo=getsymbolname_hist_FRED(Symbols.name)
urljsondata=fromJSON(
getURL(paste0("https://api.stlouisfed.org/fred/series/observations?series_id=",
fundinfo,
"&api_key=",
apikey,
"&file_type=json"))
)$observations[,3:4]
fr<-as.data.frame(urljsondata)
rm(urljsondata)
matrixval=as.numeric(as.matrix(fr[,2]))
for (k in 1:length(matrixval)) {if (is.na(matrixval[k])) {matrixval[k]=matrixval[k-1]} } #FIXING MISSING VALUES
fr <- xts(matrixval,
as.Date(fr[,1]),
src='FRED',updated=Sys.time())
rm(matrixval)
}
else { #MORNINGSTAR HISTORICAL
#GETTING FUND SID AND TYPE
fundinfo=getsymbolname_hist(Symbols.name)
urlentry=paste0("http://mschart.morningstar.com/chartweb/defaultChart?type=getcc&secids=",
fundinfo,
"&dataid=117&startdate=1900-01-02",
"&enddate=",Sys.Date(),
"¤cy=&format=1&adjusment=-1")
growthdataraw=getURL(urlentry)
growthdataraw<-gsub("NaN","\"NA\"",growthdataraw)
growthdata <- fromJSON(growthdataraw)
rm(growthdataraw)
growthdata1<-growthdata$data$r$t[[1]]
growthdata2<-growthdata1$d[[1]]
rm(growthdata)
#PRICE DATA
fr<-as.data.frame(as.numeric(growthdata2$v))
if (Symbols[[i]]=="_CASH") {fr[,1]=seq(from = 100, to = 100.1, length.out = length(fr[,1]))}
fr$Date<-as.Date(growthdata2$i,origin="1899-12-30")
fr <- xts(as.matrix(fr[,1]),
as.Date(fr[,2]),
#as.POSIXct(fr[,1], tz=Sys.getenv("TZ")),
src='longtermhist',updated=Sys.time())
}
#REMOVING ROWS WITH NA (NON TRADED DAYS)
fr=fr[!is.na(fr[,1])] * 6.71359
fr = fr[,c(1,1,1,1,1,1)] #GETTING CORRECT QUANDL COLUMNS (OPEN,HIGH,LOW,CLOSE,VOLUME,ADJUSTED)
colnames(fr) <- c('Open','High','Low','Close','Volume','Adjusted')
# #ADJUST THE OHLC BASED ON THE ADJUSTED COLUMN
# if(adjust) { fr <- adjustOHLC(fr, symbol.name=Symbols.name,use.Adjusted=T) }
fr <- convert.time.series(fr=fr,return.class=return.class)
if(is.xts(fr))
indexClass(fr) <- index.class
Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]]))
if(auto.assign)
assign(Symbols[[i]],fr,env)
#DELAY BETWEEN LOADING NEW SYMBOL
Sys.sleep(0.1)
}
if(auto.assign)
return(Symbols)
return(fr)
}
getsymbolname_hist_FRED <- function(symbol) {
if (symbol=='US_REAL_ESTATE') {return('WILLREITIND')}
if (symbol=='US_MICRO_CAP') {return('WILLMICROCAP')}
if (symbol=='GOLD_BULLION') {return('GOLDPMGBD228NLBM')}
}
getsymbolname_hist <- function(symbol) {
if (symbol=='_CASH') {return('%24FOCA%24LB%24%24;CA]FO')}
if (symbol=='US_LARGE_BLEND') {return('%24FOCA%24LB%24%24;CA]FO')}
if (symbol=='US_LARGE_VALUE') {return('%24FOCA%24LV%24%24;CA]FO')}
if (symbol=='US_LARGE_GROWTH') {return('%24FOCA%24LG%24%24;CA]FO')}
if (symbol=='US_MID_BLEND') {return('%24FOCA%24MB%24%24;CA]FO')}
if (symbol=='US_MID_VALUE') {return('%24FOCA%24MV%24%24;CA]FO')}
if (symbol=='US_MID_GROWTH') {return('%24FOCA%24MG%24%24;CA]FO')}
if (symbol=='US_SMALL_BLEND') {return('%24FOCA%24SB%24%24;CA]FO')}
if (symbol=='US_SMALL_VALUE') {return('%24FOCA%24SV%24%24;CA]FO')}
if (symbol=='US_SMALL_GROWTH') {return('%24FOCA%24SG%24%24;CA]FO')}
if (symbol=='US_COMMUNICATIONS') {return('%24FOCA%24SC%24%24;CA]FO')}
if (symbol=='US_CONS_DEFENSIVE') {return('%24FOCA%24CC%24%24;CA]FO')}
if (symbol=='US_ENERGY') {return('%24FOCA%24EE%24%24;CA]FO')}
if (symbol=='US_FINANCIALS') {return('%24FOCA%24SF%24%24;CA]FO')}
if (symbol=='US_HEALTH') {return('%24FOCA%24SH%24%24;CA]FO')}
if (symbol=='US_NATURAL_RESOURCES') {return('%24FOCA%24SN%24%24;CA]FO')}
if (symbol=='PRECIOUS_METAL') {return('%24FOCA%24SP%24%24;CA]FO')}
if (symbol=='US_REAL_ESTATE') {return('%24FOCA%24SR%24%24;CA]FO')}
if (symbol=='US_TECH') {return('%24FOCA%24ST%24%24;CA]FO')}
if (symbol=='US_UTILITIES') {return('%24FOCA%24SU%24%24;CA]FO')}
if (symbol=='US_CONVERTIBLES') {return('%24FOCA%24CV%24%24;CA]FO')}
if (symbol=='TOTAL_WORLD_STOCK') {return('%24FOCA%24WS%24%24;CA]FO')}
if (symbol=='FOREIGN_LARGE_BLEND') {return('%24FOCA%24FB%24%24;CA]FO')}
if (symbol=='FOREIGN_LARGE_VALUE') {return('%24FOCA%24FV%24%24;CA]FO')}
if (symbol=='FOREIGN_LARGE_GROWTH') {return('%24FOCA%24FG%24%24;CA]FO')}
if (symbol=='FOREIGN_MIDSMALL_VALUE') {return('%24FOCA%24FA%24%24;CA]FO')}
if (symbol=='FOREIGN_MIDSMALL_GROWTH') {return('%24FOCA%24FR%24%24;CA]FO')}
if (symbol=='DIVERSIFIED_EMERGING_EQUITY') {return('%24FOCA%24EM%24%24;CA]FO')}
if (symbol=='EUROPEAN_EQUITY') {return('%24FOCA%24ES%24%24;CA]FO')}
if (symbol=='PACIFIC_EQUITY') {return('%24FOCA%24PJ%24%24;CA]FO')}
if (symbol=='CHINA_EQUITY') {return('%24FOCA%24CH%24%24;CA]FO')}
if (symbol=='JAPAN_EQUITY') {return('%24FOCA%24JS%24%24;CA]FO')}
if (symbol=='LATIN_AMERICA_EQUITY') {return('%24FOCA%24LS%24%24;CA]FO')}
if (symbol=='GLOBAL_REAL_ESTATE') {return('%24FOCA%24GR%24%24;CA]FO')}
if (symbol=='HIGH_YIELD_MUNI') {return('%24FOCA%24HM%24%24;CA]FO')}
if (symbol=='LONG_TERM_MUNI') {return('%24FOCA%24ML%24%24;CA]FO')}
if (symbol=='INTER_TERM_MUNI') {return('%24FOCA%24MI%24%24;CA]FO')}
if (symbol=='SHORT_TERM_MUNI') {return('%24FOCA%24MS%24%24;CA]FO')}
if (symbol=='LONG_TERM_US_TREASURY') {return('%24FOCA%24GL%24%24;CA]FO')}
if (symbol=='INTER_TERM_US_TREASURY') {return('%24FOCA%24GI%24%24;CA]FO')}
if (symbol=='SHORT_TERM_US_TREASURY') {return('%24FOCA%24GS%24%24;CA]FO')}
if (symbol=='US_TREASURY_INFLATION_PROTECTED') {return('%24FOCA%24IP%24%24;CA]FO')}
if (symbol=='LONG_TERM_US_BOND_MARKET') {return('%24FOCA%24CL%24%24;CA]FO')}
if (symbol=='INTER_TERM_US_BOND_MARKET') {return('%24FOCA%24CI%24%24;CA]FO')}
if (symbol=='SHORT_TERM_US_BOND_MARKET') {return('%24FOCA%24CS%24%24;CA]FO')}
if (symbol=='ULTRASHORT_TERM_US_BOND_MARKET') {return('%24FOCA%24UB%24%24;CA]FO')}
if (symbol=='HIGH_YIELD_BOND_MARKET') {return('%24FOCA%24HY%24%24;CA]FO')}
if (symbol=='EMERGING_BOND_MARKET') {return('%24FOCA%24EB%24%24;CA]FO')}
}
#################################################################################################################################
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.