1#API
2quoteStockTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
3{
4  time.interval <- substr(time.interval,1,1)
5  function.stock <- function(quote.table.item){
6    if( xmlSize(quote.table.item) < 5) return(NULL)
7    d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
8    o <- as.number(xmlValue(quote.table.item[[2]]))
9    h <- as.number(xmlValue(quote.table.item[[3]]))
10    l <- as.number(xmlValue(quote.table.item[[4]]))
11    c <- as.number(xmlValue(quote.table.item[[5]]))
12    v <- ifelse(xmlSize(quote.table.item) >= 6,as.number(xmlValue(quote.table.item[[6]])),0)
13    a <- ifelse(xmlSize(quote.table.item) >= 7,as.number(xmlValue(quote.table.item[[7]])),0)
14    return(data.frame(date=d,open=o,high=h,low=l,close=c,volume=v, adj_close=a))
15  }
16  return(quoteTsData(x,function.stock,since,start.num,date.end,time.interval,type="stock"))
17}
18quoteFundTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
19{
20  time.interval <- substr(time.interval,1,1)
21  function.fund <- function(quote.table.item){
22    d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
23    if(time.interval=='monthly'){
24      d <- endOfMonth(d)
25    }
26    c <- as.number(xmlValue(quote.table.item[[2]]))
27    v <- as.number(xmlValue(quote.table.item[[3]]))
28    return(data.frame(date=d,constant.value=c,NAV=v))
29  }
30  return(quoteTsData(x,function.fund,since,start.num,date.end,time.interval,type="fund"))
31}
32quoteFXTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
33{
34  time.interval <- substr(time.interval,1,1)
35  function.fx <- function(quote.table.item){
36    d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
37    o <- as.number(xmlValue(quote.table.item[[2]]))
38    h <- as.number(xmlValue(quote.table.item[[3]]))
39    l <- as.number(xmlValue(quote.table.item[[4]]))
40    c <- as.number(xmlValue(quote.table.item[[5]]))
41    return(data.frame(date=d,open=o,high=h,low=l,close=c))
42  }
43  return(quoteTsData(x,function.fx,since,start.num,date.end,time.interval,type="fx"))
44}
45######  private functions  #####
46#get time series data from Yahoo! Finance.
47quoteTsData <- function(x,function.financialproduct,since,start.num,date.end,time.interval,type="stock"){
48  r <- NULL
49  financial.data <- data.frame(NULL)
50  start <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&sy=\\1&sm=\\2&sd=\\3",since))
51  end   <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&ey=\\1&em=\\2&ed=\\3",date.end))
52
53  if(!any(time.interval==c('d','w','m'))) stop("Invalid time.interval value")
54  while( 1 ){
55    start.num <- start.num + 1
56    quote.table <- NULL
57    quote.url <- paste('https://info.finance.yahoo.co.jp/history/?code=',x,start,end,'&p=',start.num,'&tm=',substr(time.interval,1,1),sep="")
58    quote.html <- getURL(quote.url)
59
60    try( r <- htmlParse(quote.html) )
61    if( is.null(r) ) stop(paste("Can not access :", quote.url))
62
63    try( quote.table <- xpathApply(r,"//table")[[2]], TRUE )
64
65    quote.size <- xmlSize(quote.table)
66
67    if( xmlSize(quote.table) <= 1 ){
68      return(financial.data)
69    }
70
71    if( is.null(quote.table) ){
72      if( is.null(financial.data) ){
73        stop(paste("Can not quote :", x))
74      }else{
75        financial.data <- financial.data[order(financial.data$date),]
76        return(financial.data)
77      }
78    }
79
80    size <- xmlSize(quote.table)
81    for(i in 2:size){
82      financial.data <- rbind(financial.data,function.financialproduct(quote.table[[i]]))
83    }
84
85    Sys.sleep(1)
86  }
87  financial.data <- financial.data[order(financial.data$date),]
88  return(financial.data)
89}
90#convert string formart date to POSIXct object
91convertToDate <- function(date.string,time.interval)
92{
93  #data format is different between monthly and dialy or weekly
94  if(any(time.interval==c('d','w'))){
95    result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-\\5",date.string)
96  }else if(time.interval=='m'){
97    result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-01",date.string)
98  }
99  return(as.POSIXct(result))
100}
101#convert string to number.
102as.number <- function(string)
103{
104  return(as.double(as.character(gsub("[^0-9.]", "",string))))
105}
106#return end of month date.
107endOfMonth <- function(date.obj)
108{
109  startOfMonth     <- as.Date(format(date.obj,"%Y%m01"),"%Y%m%d")
110  startOfNextMonth <- as.Date(format(startOfMonth+31,"%Y%m01"),"%Y%m%d")
111  return(startOfNextMonth-1)
112}
113
114