#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 )) }