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