R/DWERequest.R
In CharlesCara/Datastream2R: Allows access to Datastream data from R
# Functions are:
# getDWERequestVersion - returns the version of this package
# getDatastream - returns a connection to the DWE server and generate S3 objects
# listRequest - Function that returns a the value of Expression for the instrument list in DSCode
# In Datastream AFo this is Static request on a List eg LS&PCOMP
# timeSeriesListRequest - Function that returns a set of timeseries for an instrument list eg LS&PCOMP
# timeSeriesRequest - Function that returns a series of timeseries for a list of instruments
#
#
##############################################################################################
#'
#'
#' @title Initialise connection with Datastream DWE server
#' @description \code{getDataStream} initialises the connection with the Datastream DWE server
#' @param dweURLwsdl The URL of the server
#' @param User The username for Datastream. If not provided it will use the username from the windows registry
#' @param Pass The password for Datastream. Also sourced from Registry
#' @return a DWE connection object
#' @export
#' @importFrom SSOAP genSOAPClientInterface processWSDL
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
#'
getDataStream <- function(dweURLwsdl = "http://dataworks.thomson.com/Dataworks/Enterprise/1.0/webServiceClient.asmx?WSDL",
User=as.character("USERNAME"),
Pass=as.character("PASSWORD")
){
dweObject <- suppressMessages(suppressWarnings(genSOAPClientInterface(
def= processWSDL(dweURLwsdl, verbose=FALSE)
,verbose=FALSE,force=TRUE)))
return(c(dwe=dweObject,User=User,Pass=Pass))
}
##############################################################################################
#'
#'
#'@title Make a list request for static data
#'
#'@description \code{listRequest} Function that returns a the value of Expression for the instrument list in DSCode from Datastream
#'
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - the constituent list for the request eg LDJSTOXX
#'@param Expression - the data to return eg MNEM or NAME. If NULL or "" then we
#'will return the code that has been loaded into the User Created List.
#'@param startDate - the date of the request, or the string "TODAY"
#'@param endDate - Ignored
#'@param frequency - the frequency of the request
#'@param verbose - whether to give messages during the request
#'
#'@return returns an array of the requested information
#'@export
#'
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
listRequest <- function (dwei=getDataStream(),
DSCode,
Expression="",
startDate = Sys.Date(),
endDate=Sys.Date(),
frequency="D",
verbose=FALSE) {
#
# TODO:
# 1) Error checking of invalid input parameters
# 2) Enforce type of parameters
# Convert endDate into a string, if necessary
if(class(startDate) == "Date") {
sStartDate <- format(startDate,format="%Y-%m-%d")
} else {
sStartDate <- startDate
}
# If we have expression equal to NULL then we should retun the code in the LINK field of the response
if(is.null(Expression) || Expression == ""){
Expression <- "NAME"
getLINK <- TRUE
} else {
getLINK <- FALSE
}
#Create the request objects
#first replace the '~' character with '~~'
DSCode<-gsub("~","~~",DSCode)
instrumentCode <- paste(toupper(DSCode),"~LIST~=",toupper(Expression),
"~",sStartDate,
"~AA~NA=NaN~#",dwei$User, sep="")
ud <-new("UserData", Username = paste("DS:",dwei$User,sep=""), Password = dwei$Pass)
rd <- new("RequestData", Source = "Datastream", Instrument = instrumentCode,
Fields = as(c(""), "ArrayOfString"))
urrf <- new("User.Request.RequestFlags", User = ud, Request = rd, RequestFlags = 0L)
# Make the request from Datastream DWE
dweObject <- dwei$dwe
resultsXML <- dweObject@functions$RequestRecordAsXml(parameters = urrf, .convert = FALSE)
# Process the response
docXML = xmlRoot(xmlTreeParse(resultsXML$content))
# Check if there is an error message
messageXML <- docXML[["Body"]][["RequestRecordAsXmlResponse"]][["RequestRecordAsXmlResult"]]
if(length(messageXML[["Record"]])!=0 && !is.null(messageXML[["Record"]])){
fieldsXML <- messageXML[["Record"]][["Fields"]]
if(getLINK){
valuesXML <- fieldsXML[["LINK"]]
} else {
valuesXML <- fieldsXML[[Expression]]
}
# Extract the data into an array
values <- xmlSApply(valuesXML,function(node) xmlSApply(node,xmlValue))
# Return the data
return(values)
} else {
# There has been an error so print the error message and return NULL
message("Error returned from Datastream")
message(paste0("Number ", xmlValue(messageXML[["Error"]][["Number"]])))
message(paste0("Description: ", xmlValue(messageXML[["Error"]][["Description"]])))
return(NULL)
}
}
##############################################################################################
#' @title make a static request
#'
#'\code{staticRequest} Function that returns a the value of Expression for the array of instruments in DSCode from Datastream
#' parameters are
#'
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - an array of instruments eg c("RIO","MKS")
#'@param Expression - the data to return eg MNEM or NAME
#'@param endDate - the date of the request, or the string "TODAY"
#'@param frequency - the frequency of the request
#'@param verbose - whether to give messages during the request
#'
#'@return returns an array of the requested information
#'@export
staticRequest <- function (dwei=getDataStream(),
DSCode,
Expression="",
endDate=Sys.Date(),
frequency="D",
verbose = FALSE,
noCache = FALSE) {
maxTries <- 3
#Create the request objects
#first replace the '~' character with '~~'
DSCode<-gsub("~","~~",DSCode)
Expression<-gsub("~","~~",Expression)
sCache <- ifelse(noCache, "~/", "")
# Convert endDate into a string, if necessary
if(class(endDate) == "Date") {
sEndDate <- format(endDate,format="%Y-%m-%d")
} else {
sEndDate <- endDate
}
# Create the request string
getRecord <- function(x, Expression) {paste0(toupper(x),"~REP~=",toupper(Expression),
"~",sEndDate,
"~",sEndDate,
"~AA~NA=NaN~#",dwei$User,
sCache)}
instrumentCode <- lapply(DSCode,FUN=getRecord,Expression)
if(verbose==TRUE){cat(paste("Request string is",instrumentCode, "\n"))}
ud <-new("UserData", Username = paste("DS:",dwei$User,sep=""), Password = dwei$Pass)
rd <- lapply(instrumentCode,function(x) new("RequestData",
Source = "Datastream",
Instrument = x,
Fields = as(c(""), "ArrayOfString")))
urrf <- new("User.Requests.RequestFlags",
User = ud,
Requests = new("ArrayOfRequestData",rd),
RequestFlags = 0L)
# Make the request from Datastream DWE
dweObject <- dwei$dwe
# SSOAP has been improved in 0.9.0 to take named parameters
# Added a TryCatch on this to pick up on network errors
iCounter <- 0
repeat
{
if(verbose==TRUE){cat(paste("Requesting data try ",iCounter+1, " of ",maxTries , "\n"))}
resultsXML <- NULL
resultsXML <- try(dweObject@functions$RequestRecordsAsXml(parameters = urrf, .convert = FALSE))
if(class(resultsXML) == "SOAPHTTPReply") {break;}
if(verbose==TRUE){cat(paste("Error: message returned: ",resultsXML, "\n"))}
if(iCounter > maxTries) break
iCounter <- iCounter + 1
}
# This would happen if we have more than maxTries attempts to get data
if(class(resultsXML) != "SOAPHTTPReply") {
eval.parent(substitute(sStockList <- resultsXML))
return(NULL)
}
# Process the response
docXML = xmlRoot(xmlTreeParse(resultsXML$content))
# Check if there is an error message
messageXML <- docXML[["Body"]][["RequestRecordsAsXmlResponse"]][["RequestRecordsAsXmlResult"]]
if(length(messageXML[["Error"]])!=0 || !is.null(messageXML[["Error"]])){
# There has been an error so print the error message and return NULL
message("Error returned from Datastream")
message(paste0("Number ", xmlValue(messageXML[["Error"]][["Number"]])))
message(paste0("Description: ", xmlValue(messageXML[["Error"]][["Description"]])))
return(NULL)
}
recordsXML <- messageXML[["Records"]]
# Get list of the success status
statusCode <- sapply(xmlChildren(recordsXML),FUN=function(node) as.numeric(xmlValue(node[["StatusCode"]])))
statusMessage <- sapply(xmlChildren(recordsXML),FUN=function(node) xmlValue(node[["StatusMessage"]]))
if(verbose==TRUE){cat(paste("Status code is",statusCode, "\n"))}
if(verbose==TRUE){cat(paste("Status message is",statusMessage, "\n"))}
if(sum(statusCode) != 0){
return(data.frame(DSCode,statusMessage))
}
# Extract the data into an array
getValue <- function(node,Expression){
tryCatch(xmlValue(node[["Fields"]][[Expression]]),
error= NULL
)
}
if(verbose==TRUE){cat(paste("Number of records returned is ",length(xmlChildren(recordsXML)), "\n"))}
# Unfortunately DWE can return the value in a node that changes its name.
# My approach is to find the node that does not match any of the other possible nodes
# (ie "CCY","DATE","DISPNAME","FREQUENCY","SYMBOL")
# and assume the other node contains the values
# q is an vector that contains NA where this unmatched node is
# q <- match(names(xmlChildren(x[["Fields"]]))
nodeNames <- names(xmlChildren(recordsXML[["Record"]][["Fields"]]))
q <- match(nodeNames
,c("CCY","DATE","DISPNAME","FREQUENCY","SYMBOL"))
# get the nodename with the NA value
valNode <- nodeNames[max(is.na(q)*seq(along=q))]
rm(q)
values <- sapply(xmlChildren(recordsXML),FUN=getValue, valNode)
symbols <- sapply(xmlChildren(recordsXML),FUN=getValue, "SYMBOL")
#Merge error codes and return values
names(values) <- symbols
if(verbose==TRUE){cat(paste("Results are:\n",values, "\n"))}
# Convert into numerics if available
dfValues <- as.data.frame(values)
try.numeric <- function(x){
x1 <- tryCatch(as.numeric(x),warning = function(w) {return(NA)})
if(is.na(x1)){
return(x)
}else{
return(as.numeric(x))
}
}
dfValues$values<- lapply(dfValues[,1],FUN=try.numeric)
# Return the data
return(dfValues)
}
##############################################################################################
#' @title make a timeSeries request for a list
#'\code{timeSeriesListRequest} Function that returns a timeseries from Datastream constituent list
#' parameters are
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - the constituent list requested eg 'LFTSE100'
#'@param Instrument - the expression to return for each member of constituent list
#'@param startDate - the start date of the timeseries
#'@param endDate - the end date of the timeseries
#'@param frequency - the frequency of the request
#'@param sStockList - variable that is returned with list of of the stocks
#'@param aTimeSeries - variable that is returned with the set of timeseries
#'@param verbose - whether to give messages during the request
#'
#'@return whether the request has been successful
#' , but also
#' in sStockList: a list a two element vector of the displayname and symbol for each timeseries
#' in aTimeseries: a list of class xts with the requested timeseries information
#' @export
timeSeriesListRequest <- function (dwei=getDataStream(),
DSCode,
Instrument,
startDate,
endDate=Sys.Date(),
frequency="D",
sStockList,
aTimeSeries,
verbose=FALSE) {
constituents <- listRequest(dwei=dwei,
DSCode=DSCode,
Expression="",
startDate=startDate,
verbose=verbose)
sST <- aTS <- NULL
ret <- timeSeriesRequest(dwei=dwei,
DSCodes=constituents,
Instrument=Instrument,
startDate=startDate,
endDate=endDate,
frequency=frequency,
sStockList=sST,
aTimeSeries=aTS,
verbose=verbose)
eval.parent(substitute(sStockList <- sST))
eval.parent(substitute(aTimeSeries <- aTS))
return(ret)
}
###############################################################################################
#' @title make a timeseries request
#'
#' @details \code{timeSeriesRequest} Function that obtains a timeseries from Datastream
#' parameters are
#'
#' @param dwei - A Datastream Client Interface object created with getDataStream
#' @param DSCodes - one or more codes to return, eg "MKS" or c("MKS","SAB")
#' @param Instrument - the instrument or expression to return eg PCH#(XXXX,1M)
#' @param startDate - the start date of the timeseries
#' @param endDate - the end date of the timeseries
#' @param frequency - the frequency of the request
#' @param sStockList - variable that is returned with list of of the stocks
#' @param aTimeSeries - variable that is returned with the set of timeseries. This is a list that is not
#' guaranteed to be in the same order as sStockList
#' @param myType - the type of the return values eg numeric (default), Date or Character
#' @param verbose - whether to give messages during the request
#'
#' @return whether the request has been successful
#' in sStockList: a list a two element vector of the displayname and symbol for each timeseries
#' in aTimeseries: a list of class xts with the requested timeseries information
#'
#'
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
#' @export
timeSeriesRequest <- function (dwei=getDataStream(),
DSCodes="",
Instrument="",
startDate=Sys.Date(),
endDate=Sys.Date(),
frequency="D",
sStockList,
aTimeSeries,
myType = "numeric",
verbose=FALSE) {
maxTries <- 3
# Check the parameters are valid
# TODO: check if dwei is valid
# if(class(dwei)=="SOAPClientInterface") { return(FALSE) }
#Create the request objects
ud <-new("UserData", Username = paste("DS:",dwei$User ,sep=""), Password = dwei$Pass)
################
# First create an array of request objects. The format will depend on whether:
# 1) Instrument is blank,
# 2) a datatype,
# 3) or an expression where XXXX is replaced with the mnemonic. (This is a datastream expression but using XXXX instead of X)
#
#
DSCodes <- gsub("~","~~",DSCodes)
Instrument<-toupper(Instrument)
# Case: Instrument is blank
if(verbose==TRUE){cat(paste0("Instrument is",Instrument, "\n"))}
if(Instrument == ""){
if(verbose==TRUE){cat("Option: Instrument is blank", "\n")}
instrumentCode <- lapply(DSCodes,function(x) paste(toupper(x),
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
else{
#first replace the '~' character used in exchange rate conversions with '~~'
Instrument<-gsub("~","~~",Instrument)
if(grepl(pattern="XXXX", x=Instrument,fixed=TRUE) == FALSE){
# Case: Instrument contains a series of datatypes
#
if(verbose==TRUE){cat("Option: instrument is datatypes", "\n")}
instrumentCode <- lapply(DSCodes,function(x) paste(toupper(x),
"~=",Instrument,
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
else{
# Case: Get a list of strings that have replaced the 'XXXX' in Instrument with the Mnemonic of the stock
if(verbose==TRUE){cat("Option: instrument is an expression", "\n")}
codes <- lapply(DSCodes, function(x) gsub(pattern="XXXX",replacement=x,x=Instrument,fixed=TRUE))
instrumentCode <- lapply(codes,function(x) paste(toupper(x),
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
}
# Take instrumentCode and create the request object as well as a mapping of codes to InstrumentCodes
# print(paste("InstrumentCode is",instrumentCode))
rd <- lapply(instrumentCode,function(x) new("RequestData",
Source = "Datastream",
Instrument = x,
Fields = as(c(""), "ArrayOfString")))
instrumentCodeMap<-list(code=as.character(DSCodes),instruments=as.character(instrumentCode))
if(verbose==TRUE){cat("Instrument code map\n")}
if(verbose==TRUE){cat(format(instrumentCodeMap))}
if(verbose==TRUE){cat("\n")}
urrf <- new("User.Requests.RequestFlags",
User = ud,
Requests = new("ArrayOfRequestData",rd),
RequestFlags = 0L)
# Now we need to make the request using the RequestRecordsAsXml function
# Make the request from Datastream DWE
if(verbose==TRUE){cat("Make request\n")}
dweObject <- dwei$dwe
#SSOAP 0.9.0 now takes named parameters
# response <- dweObject@functions$RequestRecordsAsXml(User=ud,
# Request=rd,
# RequestFlags=0L,
# .convert = FALSE)
# Added a TryCatch on this to pick up on network errors
iCounter <- 0
while(iCounter < maxTries)
{
if(verbose==TRUE){cat(paste("Requesting data: attempt ",iCounter+1, " of ",maxTries , "\n"))}
response <- NULL
response <- try(dweObject@functions$RequestRecordsAsXml(parameters = urrf, .convert = FALSE))
if(class(response) == "SOAPHTTPReply") break
if(verbose==TRUE){message(paste("Error - message returned: ",response, "\n"))}
iCounter <- iCounter + 1
}
# This would happen if we have more than maxTries attempts to get data
if(class(response) != "SOAPHTTPReply") {
eval.parent(substitute(sStockList <- response))
return(NULL)
}
if(verbose==TRUE){cat("Get message content\n")}
resultsXML<-response$content
rm(response) # test if this helps with memory usage
gc() # Garbage clear
if(verbose==TRUE){cat("Process content\n")}
ourBranches <- function(){
# Need to setup the environment (ie workspace in which data is stored)
seriesNames <- new.env() #environment for the names and codes of the series
tS <- new.env() #environment for the timeSeries
tS[["count"]]<-0
tS[["ts"]] <- list()
#########
#
# We define a function that will process each chunk of the response
Record <- function(x, ...) {
# In this function we are processing the contents of the Record node
# First check if we the request was successful
status <- xmlValue(x[["StatusCode"]])
if(verbose==TRUE){cat("Status of response ", status)}
# Status of Connected - so we have fields to process
# Get the name and code of the series
instrument <- xmlValue(x[["Instrument"]])
code <- getCodeFromInstrument(instrument,instrumentCodeMap)[1]
if(verbose==TRUE){cat(" and processing ", instrument, " with code ", code,"\n")}
if(status==0){
value <- xmlValue(x[["Fields"]][["DISPNAME"]])
seriesNames[[code]] <- value
# Now get the dates and values returned as xts timeseries
datesXML <- x[["Fields"]][["DATE"]]
tmpdts <-as.Date(xmlSApply(datesXML, getNodesValue.Date), origin = as.Date("1970-01-01"))
# Unfortunately DWE can return the value in a node that changes its name.
# My approach is to find the node that does not match any of the other possible nodes
# (ie "CCY","DATE","DISPNAME","FREQUENCY","SYMBOL")
# and assume the other node contains the values
# q is an vector that contains NA where this unmatched node is
q <- match(names(xmlChildren(x[["Fields"]]))
,c("CCY","DATE","DISPNAME","FREQUENCY","SYMBOL"))
# get the index of the NA value
valNode <- max(is.na(q)*seq(along=q))
rm(q)
pricesXML <- x[["Fields"]][[valNode]]
rm(valNode)
# create the timeseries
myType <- tolower(myType)
if(myType == "date"){
tmpval <- as.Date(xmlSApply(pricesXML, getNodesValue.Date), origin = as.Date("1970-01-01"))
# xts does not seem to support dates as values - it converts them to numerics
# so we will use a data.frame to carry the data
mydf <- data.frame(tmpval, row.names = tmpdts)
t <- xts(mydf, order.by = tmpdts)
} else if(myType == "character"){
tmpval <- as.character(xmlSApply(pricesXML, getNodesValue.Character))
t <- xts(tmpval,tmpdts)
} else {
tmpval <- as.numeric(xmlSApply(pricesXML, getNodesValue.Numeric))
t <- xts(tmpval,tmpdts)
}
names(t) <- code
if(verbose==TRUE){cat("Extracted timeseries\n")}
if(verbose==TRUE){cat(paste0("Class ",class(t),"\n"))}
if(verbose==TRUE){print(head(t))}
if(verbose==TRUE){cat("\n")}
#now free up memory
rm(tmpval)
rm(tmpdts)
rm(pricesXML)
rm(datesXML)
rm(value)
}
else
{
# This means the status code is a failure for some reason
# So we want to fill in with 'dummy' columns
seriesNames[[code]] <- code
if(verbose==TRUE){cat("No data returned for ", code, "\n")}
if(verbose==TRUE){cat("Creating blank series starting in ", startDate, " of class: ", class(startDate),"\n")}
# Create an empty xts object with just the startDate. The missing dates can be merged
# in
t <- xts(NA, as.Date(startDate))
names(t) <- code
if(verbose==TRUE){cat("Created.\n")}
}
rm(instrument)
# put this xts timeseries into a list and store it
stockCount <- tS[["count"]]
stockCount <- stockCount + 1
z <- tS[["ts"]]
if(!is.null(t)){
z[[stockCount]] <- t
} else {
z[[stockCount]] <- NA
}
tS[["ts"]] <- z
tS[["count"]] <- stockCount
rm(code,t,z)
rm(stockCount,status)
if(verbose==TRUE){cat(" size ", object.size(tS[["ts"]]),"\n")}
if(verbose==TRUE){cat("Memory size", memory.size(),"\n")}
gc()
}
initialise <- function(){
tS[["Error"]] <- FALSE
}
Error <- function(x, ...){
# This is to handle the response containing an error
# There has been an error so print the error message and return NULL
message("Error returned from Datastream\n")
message(paste0("Number ", xmlValue(x[["tf:Number"]]), "\n"))
message(paste0("Description: ", xmlValue(x[["tf:Description"]]), "\n"))
tS[["Error"]] <- TRUE
}
# These convience functions are used to return data from the environment
getSeriesNames <- function(){
if(tS[["Error"]] == FALSE){
return(as.list(seriesNames))
} else {
return(NULL)
}
}
getTimeSeries <- function() {
# We merge all the timeseries into one single timeseries at this point
if(tS[["Error"]] == FALSE){
if(verbose){cat("Getting timeseries array...")}
m <- do.call(merge, tS[["ts"]])
if(verbose){cat("...done\n")}
return(m)
} else {
if(verbose){cat("Error in request, so returning null in Timeseries \n")}
return(NULL)
}
}
getCount <- function() as.integer(tS[["count"]])
getTS <- function() tS[["ts"]]
# Final element is a list of functions to be used by Branches
free <- function() {
if(verbose==TRUE){cat("Objects in environment: \n")}
if(verbose==TRUE){cat(ls())}
if(verbose==TRUE){cat("\n\n")}
rm(list=ls(name=tS),envir=tS)
rm(list=ls(name=seriesNames),envir=seriesNames)
}
list(Record=Record,
"tf:Error"=Error,
hasErrors = function() tS[["Error"]],
initialise=initialise,
getSeriesNames=getSeriesNames,
getTimeSeries=getTimeSeries,
getCount=getCount,
getTS=getTS,
free=free)
}
#
#
# End of function definition
#
##########
branches<- ourBranches()
branches$initialise()
# Now back to the main line of code
# Start processing the DWE response
if(verbose==TRUE){cat("Parsing response\n")}
doc <- invisible(xmlEventParse(resultsXML,
handlers=list(),
branches=branches,
useTagName=FALSE,
addContext = FALSE,
asText=TRUE))
# Unused is a convenience function that returns the number of timeseries
if(verbose==TRUE){cat("Returning timeseries\n")}
eval.parent(substitute(sStockList <- branches$getSeriesNames()))
eval.parent(substitute(aTimeSeries <- branches$getTimeSeries()))
tS<-branches$getTS()
# Now release objects
if(verbose==TRUE){cat("Releasing objects\n")}
if(verbose==TRUE){cat(ls())}
if(verbose==TRUE){cat("\n")}
branches$free()
rm(branches)
rm(doc)
rm(resultsXML)
gc()
return(instrumentCodeMap)
}
#' @title \code{getNodesValue.Date} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Date <-function(node) {
if(is.null(node)) {
return(NA)
}
xx <- as.Date(xmlValue(node))
if(xx == as.Date("1899-12-30")){
return(NA)
} else {
return(xx)
}
}
#' @title \code{getNodesValue.Character} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Character <-function(node) {
if(is.null(node)) {
return(NA)
}
return(as.character(xmlValue(node)))
}
#' @title \code{getNodesValue.Numeric} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Numeric <-function(node) {
if(is.null(node)) {
return(NA)
}
return(as.numeric(xmlValue(node)))
}
#' @title \code{getCodeFromInstrument} internal helper function
#' @description sort of like a hash function
#'
#' @param instrument the code of the instrument
#' @param key a two column dataframe with columns: instruments and code
#'
#' @return the code that was found
#'
getCodeFromInstrument <- function(instrument = "",key) {
return(key$code[!is.na(match(key$instruments,instrument))*seq(along=key$instruments)])
}
CharlesCara/Datastream2R documentation built on May 6, 2019, 9:57 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Functions are:
# getDWERequestVersion - returns the version of this package
# getDatastream - returns a connection to the DWE server and generate S3 objects
# listRequest - Function that returns a the value of Expression for the instrument list in DSCode
# In Datastream AFo this is Static request on a List eg LS&PCOMP
# timeSeriesListRequest - Function that returns a set of timeseries for an instrument list eg LS&PCOMP
# timeSeriesRequest - Function that returns a series of timeseries for a list of instruments
#
#
##############################################################################################
#'
#'
#' @title Initialise connection with Datastream DWE server
#' @description \code{getDataStream} initialises the connection with the Datastream DWE server
#' @param dweURLwsdl The URL of the server
#' @param User The username for Datastream. If not provided it will use the username from the windows registry
#' @param Pass The password for Datastream. Also sourced from Registry
#' @return a DWE connection object
#' @export
#' @importFrom SSOAP genSOAPClientInterface processWSDL
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
#'
getDataStream <- function(dweURLwsdl = "http://dataworks.thomson.com/Dataworks/Enterprise/1.0/webServiceClient.asmx?WSDL",
User=as.character("USERNAME"),
Pass=as.character("PASSWORD")
){
dweObject <- suppressMessages(suppressWarnings(genSOAPClientInterface(
def= processWSDL(dweURLwsdl, verbose=FALSE)
,verbose=FALSE,force=TRUE)))
return(c(dwe=dweObject,User=User,Pass=Pass))
}
##############################################################################################
#'
#'
#'@title Make a list request for static data
#'
#'@description \code{listRequest} Function that returns a the value of Expression for the instrument list in DSCode from Datastream
#'
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - the constituent list for the request eg LDJSTOXX
#'@param Expression - the data to return eg MNEM or NAME. If NULL or "" then we
#'will return the code that has been loaded into the User Created List.
#'@param startDate - the date of the request, or the string "TODAY"
#'@param endDate - Ignored
#'@param frequency - the frequency of the request
#'@param verbose - whether to give messages during the request
#'
#'@return returns an array of the requested information
#'@export
#'
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
listRequest <- function (dwei=getDataStream(),
DSCode,
Expression="",
startDate = Sys.Date(),
endDate=Sys.Date(),
frequency="D",
verbose=FALSE) {
#
# TODO:
# 1) Error checking of invalid input parameters
# 2) Enforce type of parameters
# Convert endDate into a string, if necessary
if(class(startDate) == "Date") {
sStartDate <- format(startDate,format="%Y-%m-%d")
} else {
sStartDate <- startDate
}
# If we have expression equal to NULL then we should retun the code in the LINK field of the response
if(is.null(Expression) || Expression == ""){
Expression <- "NAME"
getLINK <- TRUE
} else {
getLINK <- FALSE
}
#Create the request objects
#first replace the '~' character with '~~'
DSCode<-gsub("~","~~",DSCode)
instrumentCode <- paste(toupper(DSCode),"~LIST~=",toupper(Expression),
"~",sStartDate,
"~AA~NA=NaN~#",dwei$User, sep="")
ud <-new("UserData", Username = paste("DS:",dwei$User,sep=""), Password = dwei$Pass)
rd <- new("RequestData", Source = "Datastream", Instrument = instrumentCode,
Fields = as(c(""), "ArrayOfString"))
urrf <- new("User.Request.RequestFlags", User = ud, Request = rd, RequestFlags = 0L)
# Make the request from Datastream DWE
dweObject <- dwei$dwe
resultsXML <- dweObject@functions$RequestRecordAsXml(parameters = urrf, .convert = FALSE)
# Process the response
docXML = xmlRoot(xmlTreeParse(resultsXML$content))
# Check if there is an error message
messageXML <- docXML[["Body"]][["RequestRecordAsXmlResponse"]][["RequestRecordAsXmlResult"]]
if(length(messageXML[["Record"]])!=0 && !is.null(messageXML[["Record"]])){
fieldsXML <- messageXML[["Record"]][["Fields"]]
if(getLINK){
valuesXML <- fieldsXML[["LINK"]]
} else {
valuesXML <- fieldsXML[[Expression]]
}
# Extract the data into an array
values <- xmlSApply(valuesXML,function(node) xmlSApply(node,xmlValue))
# Return the data
return(values)
} else {
# There has been an error so print the error message and return NULL
message("Error returned from Datastream")
message(paste0("Number ", xmlValue(messageXML[["Error"]][["Number"]])))
message(paste0("Description: ", xmlValue(messageXML[["Error"]][["Description"]])))
return(NULL)
}
}
##############################################################################################
#' @title make a static request
#'
#'\code{staticRequest} Function that returns a the value of Expression for the array of instruments in DSCode from Datastream
#' parameters are
#'
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - an array of instruments eg c("RIO","MKS")
#'@param Expression - the data to return eg MNEM or NAME
#'@param endDate - the date of the request, or the string "TODAY"
#'@param frequency - the frequency of the request
#'@param verbose - whether to give messages during the request
#'
#'@return returns an array of the requested information
#'@export
staticRequest <- function (dwei=getDataStream(),
DSCode,
Expression="",
endDate=Sys.Date(),
frequency="D",
verbose = FALSE,
noCache = FALSE) {
maxTries <- 3
#Create the request objects
#first replace the '~' character with '~~'
DSCode<-gsub("~","~~",DSCode)
Expression<-gsub("~","~~",Expression)
sCache <- ifelse(noCache, "~/", "")
# Convert endDate into a string, if necessary
if(class(endDate) == "Date") {
sEndDate <- format(endDate,format="%Y-%m-%d")
} else {
sEndDate <- endDate
}
# Create the request string
getRecord <- function(x, Expression) {paste0(toupper(x),"~REP~=",toupper(Expression),
"~",sEndDate,
"~",sEndDate,
"~AA~NA=NaN~#",dwei$User,
sCache)}
instrumentCode <- lapply(DSCode,FUN=getRecord,Expression)
if(verbose==TRUE){cat(paste("Request string is",instrumentCode, "\n"))}
ud <-new("UserData", Username = paste("DS:",dwei$User,sep=""), Password = dwei$Pass)
rd <- lapply(instrumentCode,function(x) new("RequestData",
Source = "Datastream",
Instrument = x,
Fields = as(c(""), "ArrayOfString")))
urrf <- new("User.Requests.RequestFlags",
User = ud,
Requests = new("ArrayOfRequestData",rd),
RequestFlags = 0L)
# Make the request from Datastream DWE
dweObject <- dwei$dwe
# SSOAP has been improved in 0.9.0 to take named parameters
# Added a TryCatch on this to pick up on network errors
iCounter <- 0
repeat
{
if(verbose==TRUE){cat(paste("Requesting data try ",iCounter+1, " of ",maxTries , "\n"))}
resultsXML <- NULL
resultsXML <- try(dweObject@functions$RequestRecordsAsXml(parameters = urrf, .convert = FALSE))
if(class(resultsXML) == "SOAPHTTPReply") {break;}
if(verbose==TRUE){cat(paste("Error: message returned: ",resultsXML, "\n"))}
if(iCounter > maxTries) break
iCounter <- iCounter + 1
}
# This would happen if we have more than maxTries attempts to get data
if(class(resultsXML) != "SOAPHTTPReply") {
eval.parent(substitute(sStockList <- resultsXML))
return(NULL)
}
# Process the response
docXML = xmlRoot(xmlTreeParse(resultsXML$content))
# Check if there is an error message
messageXML <- docXML[["Body"]][["RequestRecordsAsXmlResponse"]][["RequestRecordsAsXmlResult"]]
if(length(messageXML[["Error"]])!=0 || !is.null(messageXML[["Error"]])){
# There has been an error so print the error message and return NULL
message("Error returned from Datastream")
message(paste0("Number ", xmlValue(messageXML[["Error"]][["Number"]])))
message(paste0("Description: ", xmlValue(messageXML[["Error"]][["Description"]])))
return(NULL)
}
recordsXML <- messageXML[["Records"]]
# Get list of the success status
statusCode <- sapply(xmlChildren(recordsXML),FUN=function(node) as.numeric(xmlValue(node[["StatusCode"]])))
statusMessage <- sapply(xmlChildren(recordsXML),FUN=function(node) xmlValue(node[["StatusMessage"]]))
if(verbose==TRUE){cat(paste("Status code is",statusCode, "\n"))}
if(verbose==TRUE){cat(paste("Status message is",statusMessage, "\n"))}
if(sum(statusCode) != 0){
return(data.frame(DSCode,statusMessage))
}
# Extract the data into an array
getValue <- function(node,Expression){
tryCatch(xmlValue(node[["Fields"]][[Expression]]),
error= NULL
)
}
if(verbose==TRUE){cat(paste("Number of records returned is ",length(xmlChildren(recordsXML)), "\n"))}
# Unfortunately DWE can return the value in a node that changes its name.
# My approach is to find the node that does not match any of the other possible nodes
# (ie "CCY","DATE","DISPNAME","FREQUENCY","SYMBOL")
# and assume the other node contains the values
# q is an vector that contains NA where this unmatched node is
# q <- match(names(xmlChildren(x[["Fields"]]))
nodeNames <- names(xmlChildren(recordsXML[["Record"]][["Fields"]]))
q <- match(nodeNames
,c("CCY","DATE","DISPNAME","FREQUENCY","SYMBOL"))
# get the nodename with the NA value
valNode <- nodeNames[max(is.na(q)*seq(along=q))]
rm(q)
values <- sapply(xmlChildren(recordsXML),FUN=getValue, valNode)
symbols <- sapply(xmlChildren(recordsXML),FUN=getValue, "SYMBOL")
#Merge error codes and return values
names(values) <- symbols
if(verbose==TRUE){cat(paste("Results are:\n",values, "\n"))}
# Convert into numerics if available
dfValues <- as.data.frame(values)
try.numeric <- function(x){
x1 <- tryCatch(as.numeric(x),warning = function(w) {return(NA)})
if(is.na(x1)){
return(x)
}else{
return(as.numeric(x))
}
}
dfValues$values<- lapply(dfValues[,1],FUN=try.numeric)
# Return the data
return(dfValues)
}
##############################################################################################
#' @title make a timeSeries request for a list
#'\code{timeSeriesListRequest} Function that returns a timeseries from Datastream constituent list
#' parameters are
#'@param dwei - A Datastream Client Interface object created with getDataStream
#'@param DSCode - the constituent list requested eg 'LFTSE100'
#'@param Instrument - the expression to return for each member of constituent list
#'@param startDate - the start date of the timeseries
#'@param endDate - the end date of the timeseries
#'@param frequency - the frequency of the request
#'@param sStockList - variable that is returned with list of of the stocks
#'@param aTimeSeries - variable that is returned with the set of timeseries
#'@param verbose - whether to give messages during the request
#'
#'@return whether the request has been successful
#' , but also
#' in sStockList: a list a two element vector of the displayname and symbol for each timeseries
#' in aTimeseries: a list of class xts with the requested timeseries information
#' @export
timeSeriesListRequest <- function (dwei=getDataStream(),
DSCode,
Instrument,
startDate,
endDate=Sys.Date(),
frequency="D",
sStockList,
aTimeSeries,
verbose=FALSE) {
constituents <- listRequest(dwei=dwei,
DSCode=DSCode,
Expression="",
startDate=startDate,
verbose=verbose)
sST <- aTS <- NULL
ret <- timeSeriesRequest(dwei=dwei,
DSCodes=constituents,
Instrument=Instrument,
startDate=startDate,
endDate=endDate,
frequency=frequency,
sStockList=sST,
aTimeSeries=aTS,
verbose=verbose)
eval.parent(substitute(sStockList <- sST))
eval.parent(substitute(aTimeSeries <- aTS))
return(ret)
}
###############################################################################################
#' @title make a timeseries request
#'
#' @details \code{timeSeriesRequest} Function that obtains a timeseries from Datastream
#' parameters are
#'
#' @param dwei - A Datastream Client Interface object created with getDataStream
#' @param DSCodes - one or more codes to return, eg "MKS" or c("MKS","SAB")
#' @param Instrument - the instrument or expression to return eg PCH#(XXXX,1M)
#' @param startDate - the start date of the timeseries
#' @param endDate - the end date of the timeseries
#' @param frequency - the frequency of the request
#' @param sStockList - variable that is returned with list of of the stocks
#' @param aTimeSeries - variable that is returned with the set of timeseries. This is a list that is not
#' guaranteed to be in the same order as sStockList
#' @param myType - the type of the return values eg numeric (default), Date or Character
#' @param verbose - whether to give messages during the request
#'
#' @return whether the request has been successful
#' in sStockList: a list a two element vector of the displayname and symbol for each timeseries
#' in aTimeseries: a list of class xts with the requested timeseries information
#'
#'
#' @import XMLSchema
#' @import XML
#' @import zoo
#' @import xts
#' @export
timeSeriesRequest <- function (dwei=getDataStream(),
DSCodes="",
Instrument="",
startDate=Sys.Date(),
endDate=Sys.Date(),
frequency="D",
sStockList,
aTimeSeries,
myType = "numeric",
verbose=FALSE) {
maxTries <- 3
# Check the parameters are valid
# TODO: check if dwei is valid
# if(class(dwei)=="SOAPClientInterface") { return(FALSE) }
#Create the request objects
ud <-new("UserData", Username = paste("DS:",dwei$User ,sep=""), Password = dwei$Pass)
################
# First create an array of request objects. The format will depend on whether:
# 1) Instrument is blank,
# 2) a datatype,
# 3) or an expression where XXXX is replaced with the mnemonic. (This is a datastream expression but using XXXX instead of X)
#
#
DSCodes <- gsub("~","~~",DSCodes)
Instrument<-toupper(Instrument)
# Case: Instrument is blank
if(verbose==TRUE){cat(paste0("Instrument is",Instrument, "\n"))}
if(Instrument == ""){
if(verbose==TRUE){cat("Option: Instrument is blank", "\n")}
instrumentCode <- lapply(DSCodes,function(x) paste(toupper(x),
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
else{
#first replace the '~' character used in exchange rate conversions with '~~'
Instrument<-gsub("~","~~",Instrument)
if(grepl(pattern="XXXX", x=Instrument,fixed=TRUE) == FALSE){
# Case: Instrument contains a series of datatypes
#
if(verbose==TRUE){cat("Option: instrument is datatypes", "\n")}
instrumentCode <- lapply(DSCodes,function(x) paste(toupper(x),
"~=",Instrument,
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
else{
# Case: Get a list of strings that have replaced the 'XXXX' in Instrument with the Mnemonic of the stock
if(verbose==TRUE){cat("Option: instrument is an expression", "\n")}
codes <- lapply(DSCodes, function(x) gsub(pattern="XXXX",replacement=x,x=Instrument,fixed=TRUE))
instrumentCode <- lapply(codes,function(x) paste(toupper(x),
"~",format(startDate,format="%Y-%m-%d"),
"~:",format(endDate,format="%Y-%m-%d"),
"~", frequency,
"~AA~NA=NaN~#",dwei$User, sep=""))
}
}
# Take instrumentCode and create the request object as well as a mapping of codes to InstrumentCodes
# print(paste("InstrumentCode is",instrumentCode))
rd <- lapply(instrumentCode,function(x) new("RequestData",
Source = "Datastream",
Instrument = x,
Fields = as(c(""), "ArrayOfString")))
instrumentCodeMap<-list(code=as.character(DSCodes),instruments=as.character(instrumentCode))
if(verbose==TRUE){cat("Instrument code map\n")}
if(verbose==TRUE){cat(format(instrumentCodeMap))}
if(verbose==TRUE){cat("\n")}
urrf <- new("User.Requests.RequestFlags",
User = ud,
Requests = new("ArrayOfRequestData",rd),
RequestFlags = 0L)
# Now we need to make the request using the RequestRecordsAsXml function
# Make the request from Datastream DWE
if(verbose==TRUE){cat("Make request\n")}
dweObject <- dwei$dwe
#SSOAP 0.9.0 now takes named parameters
# response <- dweObject@functions$RequestRecordsAsXml(User=ud,
# Request=rd,
# RequestFlags=0L,
# .convert = FALSE)
# Added a TryCatch on this to pick up on network errors
iCounter <- 0
while(iCounter < maxTries)
{
if(verbose==TRUE){cat(paste("Requesting data: attempt ",iCounter+1, " of ",maxTries , "\n"))}
response <- NULL
response <- try(dweObject@functions$RequestRecordsAsXml(parameters = urrf, .convert = FALSE))
if(class(response) == "SOAPHTTPReply") break
if(verbose==TRUE){message(paste("Error - message returned: ",response, "\n"))}
iCounter <- iCounter + 1
}
# This would happen if we have more than maxTries attempts to get data
if(class(response) != "SOAPHTTPReply") {
eval.parent(substitute(sStockList <- response))
return(NULL)
}
if(verbose==TRUE){cat("Get message content\n")}
resultsXML<-response$content
rm(response) # test if this helps with memory usage
gc() # Garbage clear
if(verbose==TRUE){cat("Process content\n")}
ourBranches <- function(){
# Need to setup the environment (ie workspace in which data is stored)
seriesNames <- new.env() #environment for the names and codes of the series
tS <- new.env() #environment for the timeSeries
tS[["count"]]<-0
tS[["ts"]] <- list()
#########
#
# We define a function that will process each chunk of the response
Record <- function(x, ...) {
# In this function we are processing the contents of the Record node
# First check if we the request was successful
status <- xmlValue(x[["StatusCode"]])
if(verbose==TRUE){cat("Status of response ", status)}
# Status of Connected - so we have fields to process
# Get the name and code of the series
instrument <- xmlValue(x[["Instrument"]])
code <- getCodeFromInstrument(instrument,instrumentCodeMap)[1]
if(verbose==TRUE){cat(" and processing ", instrument, " with code ", code,"\n")}
if(status==0){
value <- xmlValue(x[["Fields"]][["DISPNAME"]])
seriesNames[[code]] <- value
# Now get the dates and values returned as xts timeseries
datesXML <- x[["Fields"]][["DATE"]]
tmpdts <-as.Date(xmlSApply(datesXML, getNodesValue.Date), origin = as.Date("1970-01-01"))
# Unfortunately DWE can return the value in a node that changes its name.
# My approach is to find the node that does not match any of the other possible nodes
# (ie "CCY","DATE","DISPNAME","FREQUENCY","SYMBOL")
# and assume the other node contains the values
# q is an vector that contains NA where this unmatched node is
q <- match(names(xmlChildren(x[["Fields"]]))
,c("CCY","DATE","DISPNAME","FREQUENCY","SYMBOL"))
# get the index of the NA value
valNode <- max(is.na(q)*seq(along=q))
rm(q)
pricesXML <- x[["Fields"]][[valNode]]
rm(valNode)
# create the timeseries
myType <- tolower(myType)
if(myType == "date"){
tmpval <- as.Date(xmlSApply(pricesXML, getNodesValue.Date), origin = as.Date("1970-01-01"))
# xts does not seem to support dates as values - it converts them to numerics
# so we will use a data.frame to carry the data
mydf <- data.frame(tmpval, row.names = tmpdts)
t <- xts(mydf, order.by = tmpdts)
} else if(myType == "character"){
tmpval <- as.character(xmlSApply(pricesXML, getNodesValue.Character))
t <- xts(tmpval,tmpdts)
} else {
tmpval <- as.numeric(xmlSApply(pricesXML, getNodesValue.Numeric))
t <- xts(tmpval,tmpdts)
}
names(t) <- code
if(verbose==TRUE){cat("Extracted timeseries\n")}
if(verbose==TRUE){cat(paste0("Class ",class(t),"\n"))}
if(verbose==TRUE){print(head(t))}
if(verbose==TRUE){cat("\n")}
#now free up memory
rm(tmpval)
rm(tmpdts)
rm(pricesXML)
rm(datesXML)
rm(value)
}
else
{
# This means the status code is a failure for some reason
# So we want to fill in with 'dummy' columns
seriesNames[[code]] <- code
if(verbose==TRUE){cat("No data returned for ", code, "\n")}
if(verbose==TRUE){cat("Creating blank series starting in ", startDate, " of class: ", class(startDate),"\n")}
# Create an empty xts object with just the startDate. The missing dates can be merged
# in
t <- xts(NA, as.Date(startDate))
names(t) <- code
if(verbose==TRUE){cat("Created.\n")}
}
rm(instrument)
# put this xts timeseries into a list and store it
stockCount <- tS[["count"]]
stockCount <- stockCount + 1
z <- tS[["ts"]]
if(!is.null(t)){
z[[stockCount]] <- t
} else {
z[[stockCount]] <- NA
}
tS[["ts"]] <- z
tS[["count"]] <- stockCount
rm(code,t,z)
rm(stockCount,status)
if(verbose==TRUE){cat(" size ", object.size(tS[["ts"]]),"\n")}
if(verbose==TRUE){cat("Memory size", memory.size(),"\n")}
gc()
}
initialise <- function(){
tS[["Error"]] <- FALSE
}
Error <- function(x, ...){
# This is to handle the response containing an error
# There has been an error so print the error message and return NULL
message("Error returned from Datastream\n")
message(paste0("Number ", xmlValue(x[["tf:Number"]]), "\n"))
message(paste0("Description: ", xmlValue(x[["tf:Description"]]), "\n"))
tS[["Error"]] <- TRUE
}
# These convience functions are used to return data from the environment
getSeriesNames <- function(){
if(tS[["Error"]] == FALSE){
return(as.list(seriesNames))
} else {
return(NULL)
}
}
getTimeSeries <- function() {
# We merge all the timeseries into one single timeseries at this point
if(tS[["Error"]] == FALSE){
if(verbose){cat("Getting timeseries array...")}
m <- do.call(merge, tS[["ts"]])
if(verbose){cat("...done\n")}
return(m)
} else {
if(verbose){cat("Error in request, so returning null in Timeseries \n")}
return(NULL)
}
}
getCount <- function() as.integer(tS[["count"]])
getTS <- function() tS[["ts"]]
# Final element is a list of functions to be used by Branches
free <- function() {
if(verbose==TRUE){cat("Objects in environment: \n")}
if(verbose==TRUE){cat(ls())}
if(verbose==TRUE){cat("\n\n")}
rm(list=ls(name=tS),envir=tS)
rm(list=ls(name=seriesNames),envir=seriesNames)
}
list(Record=Record,
"tf:Error"=Error,
hasErrors = function() tS[["Error"]],
initialise=initialise,
getSeriesNames=getSeriesNames,
getTimeSeries=getTimeSeries,
getCount=getCount,
getTS=getTS,
free=free)
}
#
#
# End of function definition
#
##########
branches<- ourBranches()
branches$initialise()
# Now back to the main line of code
# Start processing the DWE response
if(verbose==TRUE){cat("Parsing response\n")}
doc <- invisible(xmlEventParse(resultsXML,
handlers=list(),
branches=branches,
useTagName=FALSE,
addContext = FALSE,
asText=TRUE))
# Unused is a convenience function that returns the number of timeseries
if(verbose==TRUE){cat("Returning timeseries\n")}
eval.parent(substitute(sStockList <- branches$getSeriesNames()))
eval.parent(substitute(aTimeSeries <- branches$getTimeSeries()))
tS<-branches$getTS()
# Now release objects
if(verbose==TRUE){cat("Releasing objects\n")}
if(verbose==TRUE){cat(ls())}
if(verbose==TRUE){cat("\n")}
branches$free()
rm(branches)
rm(doc)
rm(resultsXML)
gc()
return(instrumentCodeMap)
}
#' @title \code{getNodesValue.Date} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Date <-function(node) {
if(is.null(node)) {
return(NA)
}
xx <- as.Date(xmlValue(node))
if(xx == as.Date("1899-12-30")){
return(NA)
} else {
return(xx)
}
}
#' @title \code{getNodesValue.Character} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Character <-function(node) {
if(is.null(node)) {
return(NA)
}
return(as.character(xmlValue(node)))
}
#' @title \code{getNodesValue.Numeric} internal helper function
#' @description gets the date value of an xmlnode
#' @param node the xmlNode to get the values from
#'
#' @return the values in the node
#'
#' @importFrom XML xmlSApply
#'
getNodesValue.Numeric <-function(node) {
if(is.null(node)) {
return(NA)
}
return(as.numeric(xmlValue(node)))
}
#' @title \code{getCodeFromInstrument} internal helper function
#' @description sort of like a hash function
#'
#' @param instrument the code of the instrument
#' @param key a two column dataframe with columns: instruments and code
#'
#' @return the code that was found
#'
getCodeFromInstrument <- function(instrument = "",key) {
return(key$code[!is.na(match(key$instruments,instrument))*seq(along=key$instruments)])
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.