#License: GPL
#for debug
#source("get.yahoo.jp.R")
#get.yahoo.jp("998407","2006-1-1","2006-1-20")
#get stock data from yahoo.co.jp
get.yahoo.jp <- function (instrument = "998407", start, end,
quote = c("Open","High", "Low", "Close","Volume","AdjClose"), provider = c("yahoo.jp"),
method = "auto", origin = "1899-12-30", compression = "d",
retclass = c("zoo", "its", "ts")){
if (missing(start))
start <- "1991-01-02"
#if (missing(end))
# end <- format(Sys.Date() - 1, "%Y-%m-%d")
if (missing(end))
end <- format(Sys.Date(), "%Y-%m-%d")
provider <- match.arg(provider)
retclass <- match.arg(retclass)
x <- NULL
if(instrument == "998407"){
#for N225.
names <-c("Date","Open","High","Low","Close")
}else{
names <-c("Date","Open","High","Low","Close","Volume","AdjClose")
}
yidx = 0
while(TRUE){
#urlの組立
startdate <- unlist(strsplit(start,"-"))
enddate <- unlist(strsplit(end,"-"))
url <- paste("http://table.yahoo.co.jp/t?s=", instrument,
"&c=",startdate[1],"&a=",startdate[2],"&b=",startdate[3],
"&f=",enddate[1],"&d=",enddate[2],"&e=",enddate[3],
"&g=",compression,
"&q=q",
"&y=",as.character(yidx),
"&z=", instrument,
"&x=.csv",
sep = "")
#データのダウンロード
htmlfile <- tempfile()
status <- download.file(url, htmlfile, method = method)
if (status != 0) {
unlink(htmlfile)
warning(paste("download error, status", status,", instrument", instrument))
return(NULL)
}
lines <- readLines(htmlfile)
unlink(htmlfile)
#table.yahoo.co.jp has invalid string.(data broken?)2006-01-30
lines <- lines[-3]
#read data in table tag
xtmp <- grep(paste("(
.*){",length(names),"}",sep=""), lines, value =TRUE)
xtmp <- strsplit(xtmp, " | ")
x <- append(x,xtmp)
#check hasnext まだ続きがあるかurlの&y=件数で判断。
yidxs <- grep("]*&y=([[:digit:]]*)",lines,value=TRUE)
yidxs <- gsub(".*]*&y=([[:digit:]]*).*","\\1",yidxs)
yidxs <- as.numeric(yidxs)
if(length(yidxs)==0 || max(yidxs) < yidx){
break
}
yidx <- yidx +50
}
#x <- rev(x)
x <- sapply(x, get.yahoo.jp.parse)
if (length(x) == 0) {
warning(paste("no data available for", instrument))
return(NULL)
}
x <- t(x)
x <- data.frame(as.Date(x[,1]), apply(x[,2:length(names), drop=FALSE], c(1,2), as.numeric))
colnames(x) <- names
n <- nrow(x)
nser <- 2:length(names)
dat <- x[, 1]
if (retclass == "ts") {
jdat <- unclass(julian(dat, origin = as.Date(origin)))
ind <- jdat - jdat[n] + 1
y <- matrix(NA, nr = max(ind), nc = length(nser))
y[ind, ] <- as.matrix(x[, nser, drop = FALSE])
colnames(y) <- names(x)[nser]
return(ts(y, start = jdat[n], end = jdat[1]))
}
else {
x <- as.matrix(x[, nser, drop = FALSE])
rownames(x) <- NULL
y <- zoo(x, dat)
if (retclass == "its") {
if ("package:its" %in% search() || require("its", quietly = TRUE)) {
index(y) <- as.POSIXct(index(y))
y <- its::as.its(y)
}
else {
warning("package its could not be loaded: zoo series returned")
}
}
return(y)
}
}
get.yahoo.jp.parse <-function (strs ="") {
#日付データに変換
date <- gsub("[^[:digit:]]*([[:digit:]]{4})[^[:digit:]]*([[:digit:]]{1,2})[^[:digit:]]*([[:digit:]]{1,2})[^[:digit:]]*",
"\\1-\\2-\\3", strs[1])
#date <- as.Date(date, "%Y-%m-%d")
#del tag, del comma
stocks <- gsub("<[^<]*>|,","",strs[2:7])
#stocks <- as.numeric( gsub("<[^<]*>|,","",strs[2:7]))
return( c(date, stocks ))
#return( append( list(date), stocks ))
}