Other/memorySinkTest.R

In CharlesCara/Datastream2R: Allows access to Datastream data from R

seriesNames <- new.env() #environment for the names and codes of the series
tS <- new.env()  #environment for the timeSeries
tS[["count"]]<-0

RecordBlank <- function(x,...){
   t<-xts(NA,startDate)
   names(t) <- "TEST"
   stockCount<- tS[["count"]]
   stockCount<-stockCount+1
   z<- tS[["ts"]]
   z[[stockCount]]<-t
   tS[["ts"]] <- z
   tS[["count"]] <- stockCount
   rm(t,z)
   rm(stockCount)
   gc()
   
   
}

   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))
         # 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
         tmpval<-as.numeric(xmlSApply(pricesXML,function(node) xmlSApply(node,xmlValue)))    
         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, "\n")}
         # Create an empty xts object with just the startDate.  The missing dates can be merged
         # in 
         t<-xts(NA,startDate)
         names(t) <- code
      }
      rm(instrument)
      # put this xts timeseries into a list and store it      
      stockCount<- tS[["count"]]
      stockCount<-stockCount+1
      z<- tS[["ts"]]
      z[[stockCount]]<-t
      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()
   }
   
   # These convience functions are used to return data from the environment
   getSeriesNames <- function() as.list(seriesNames)
   getTimeSeries <- function() {
      # We merge all the timeseries into one single timeseries at this point
      if(verbose==TRUE){cat("Getting timeseries array...")}
      m <- do.call(merge,tS[["ts"]])
      if(verbose==TRUE){cat("...done\n")}
      return(m)
   }
   getCount <- function() as.integer(tS[["count"]])
   getTS <- function() return(tS[["ts"]])
   # Final element is a list of functions to be used by Branches
   freeTS <- 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)
      
   }




###############################################################

dwei <- getDataStream(User=options()$Datastream.Username, Pass=options()$Datastream.Password)

DSCodes <- c("MKS", "D:BAS")
# DSCodes <- c("ADN","ADM","AGK","AAL","ANTO","ARM","AHT","ABF","AZN","AV.","BAB","BA.","BARC","BDEV","BG.","BLT",
#              "BP.","BATS","BLND","BSY","BT.A","BNZL","BRBY","CPI","CCL","CNA","CCH","CPG","CRH","DGE","EZJ",
#              "EXPN","FRES","FLG","GFS","GKN","GSK","GLEN","HMSO","HL.","HSBA","IMI","IMT","IHG","IAG","ITRK",
#              "INTU","ITV","JMAT","KGF","LAND","LGEN","LLOY","LSE","MKS")
datatype = "MV"
startDate <- as.Date("31/12/2013", "%d/%m/%Y")
endDate <- Sys.Date()
frequency <- "D"
Instrument<-toupper(datatype)

Instrument<-gsub("~","~~",Instrument)

if(grepl(pattern="XXXX", x=Instrument,fixed=TRUE) == FALSE){
   # Case: Instrument contains a series of datatypes
   #
   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

   codes <- lapply(DSCodes, function(x) gsub(pattern="XXXX",replacement=x,x=Instrument,fixed=TRUE))
   
   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=""))
}


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)


instrumentCodeMap<-list(code=as.character(DSCodes),instruments=as.character(instrumentCode))





#####################################################################


   dweObject <- dwei$dwe   
   response <- try(dweObject@functions$RequestRecordsAsXml(parameters = urrf, .convert = FALSE))
   resultsXML<-response$content
   print(object.size(resultsXML))

   
verbose=FALSE
for(i in 1:10000){
   
   doc <- xmlTreeParse(resultsXML, asText=TRUE,useInternalNodes=TRUE)  #handlers=list())
#   docBody <- doc$doc$children$Envelope
xmlEnvelope <-    xmlChildren(doc)$Envelope
xmlBody <- xmlChildren(xmlEnvelope)$Body 
#   docResult <- docBody[["Body"]][["RequestRecordsAsXmlResponse"]][["RequestRecordsAsXmlResult"]]
#   docRecords <- docResult[["Records"]]
   
   print(paste0("Loop: ",i))
#   seriesNames <- new.env() #environment for the names and codes of the series
#   tS <- new.env()  #environment for the timeSeries
#   tS[["count"]]<-0
   
#   for(iSeries in 1: length(docRecords)){
#      docRecordi <- docRecords[iSeries]
#      docRecord <- docRecordi["Record"]
#      RecordBlank(docRecord$Record,verbose=FALSE)
#      rm(docRecordi,docRecord)

#   }
   #print(head(getTimeSeries()))
#free(xmlBody)
rm(xmlEnvelope)
rm(xmlBody)
free(doc)
rm(doc)
}
gc()