Rでチャートを書いてみる(5)

いつの間にかQiitaに引用されていました。（＾＾！

http://qiita.com/HirofumiYashima/items/4b3a3a3e49be59d81e4f

うまく動かないとのことなので修正をしてみました。

RFinanceYJはYahooのHTML変更に振り回されているようで、うまく動かない場合が多いです。

> library(RFinanceYJ)
> quoteStockTsData("6758.t")
 以下にエラー order(financial.data$date) :	引数 1 がベクトルではありません

> library(RFinanceYJ)

> quoteStockTsData("6758.t")

以下にエラー order(financial.data$date) : 引数 1 がベクトルではありません

どうもStockTsDataの↓の部分でテーブルの形を決まりきった物として扱っているので、Yahoo側のちょっとした変更（たとえば上の方になんか広告などを追加するとか）に負けてしまっています。

	extractQuoteTable <- function(r,type){
		if(type %in% c("fund","fx")){
			tbl <- r[[2]][[2]][[7]][[3]][[3]][[9]][[2]]
		}
		else{
			tbl <- r[[2]][[2]][[7]][[3]][[3]][[10]][[2]]
		}
		return(tbl)
	}
	
	while( result.num >= 51 ){
		start.num <- start.num + 1
		quote.table <- NULL
		quote.url <- paste('http://info.finance.yahoo.co.jp/history/?code=',x,start,end,'&p=',start.num,'&tm=',substr(time.interval,1,1),sep="")

..

		#try( quote.table <- r[[2]][[1]][[1]][[16]][[1]][[1]][[1]][[4]][[1]][[1]][[1]], TRUE )
		try( quote.table <- extractQuoteTable(r,type), TRUE )

extractQuoteTable <- function(r,type){

if(type %in% c("fund","fx")){

tbl <- r[[2]][[2]][[7]][[3]][[3]][[9]][[2]]

}

else{

tbl <- r[[2]][[2]][[7]][[3]][[3]][[10]][[2]]

}

return(tbl)

}

while( result.num >= 51 ){

start.num <- start.num + 1

quote.table <- NULL

quote.url <- paste('http://info.finance.yahoo.co.jp/history/?code=',x,start,end,'&p=',start.num,'&tm=',substr(time.interval,1,1),sep="")

#try( quote.table <- r[[2]][[1]][[1]][[16]][[1]][[1]][[1]][[4]][[1]][[1]][[1]], TRUE )

try( quote.table <- extractQuoteTable(r,type), TRUE )

Xpathで解析するようにし、若干の変更には耐えられるように修正してみました。この株価ページにはテーブルが３個あり、その２番目が株価のテーブルですので、最新版の0.3.1にまたまたパッチを当ててみました。こう書き換えます。

		#try( quote.table <- extractQuoteTable(r,type), TRUE )
		try( quote.table <- xpathApply(r,"//table")[[2]], TRUE )

1 2	#try( quote.table <- extractQuoteTable(r,type), TRUE ) try( quote.table <- xpathApply(r,"//table")[[2]], TRUE )

この関数だけを読み込んでもだめなので全体を記述しそれをlibrary(RFinanceYJ)に続けて読んでやります

library(RFinanceYJ)
#API
quoteStockTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
{
	time.interval <- substr(time.interval,1,1)
	function.stock <- function(quote.table.item){
		if( xmlSize(quote.table.item) < 5) return(NULL) 
		d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
		o <- as.number(xmlValue(quote.table.item[[2]]))
		h <- as.number(xmlValue(quote.table.item[[3]]))
		l <- as.number(xmlValue(quote.table.item[[4]]))
		c <- as.number(xmlValue(quote.table.item[[5]]))
		v <- ifelse(xmlSize(quote.table.item) >= 6,as.number(xmlValue(quote.table.item[[6]])),0)
		a <- ifelse(xmlSize(quote.table.item) >= 7,as.number(xmlValue(quote.table.item[[7]])),0)
		return(data.frame(date=d,open=o,high=h,low=l,close=c,volume=v, adj_close=a))
	}
	return(quoteTsData(x,function.stock,since,start.num,date.end,time.interval,type="stock"))
}
quoteFundTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
{
	time.interval <- substr(time.interval,1,1)
	function.fund <- function(quote.table.item){
		d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
		if(time.interval=='monthly'){
			d <- endOfMonth(d)
		}
		c <- as.number(xmlValue(quote.table.item[[2]]))
		v <- as.number(xmlValue(quote.table.item[[3]]))
		return(data.frame(date=d,constant.value=c,NAV=v))
	}
	return(quoteTsData(x,function.fund,since,start.num,date.end,time.interval,type="fund"))
}
quoteFXTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')
{
	time.interval <- substr(time.interval,1,1)
	function.fx <- function(quote.table.item){
		d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)
		o <- as.number(xmlValue(quote.table.item[[2]]))
		h <- as.number(xmlValue(quote.table.item[[3]]))
		l <- as.number(xmlValue(quote.table.item[[4]]))
		c <- as.number(xmlValue(quote.table.item[[5]]))
		return(data.frame(date=d,open=o,high=h,low=l,close=c))
	}
	return(quoteTsData(x,function.fx,since,start.num,date.end,time.interval,type="fx"))
}
######	private functions	#####
#get time series data from Yahoo! Finance.
quoteTsData <- function(x,function.financialproduct,since,start.num,date.end,time.interval,type="stock"){
	r <- NULL
	result.num <- 51
	financial.data <- data.frame(NULL)
	#start <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&c=\\1&a=\\2&b=\\3",since))
	#end	 <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&f=\\1&d=\\2&e=\\3",date.end))
	start <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&sy=\\1&sm=\\2&sd=\\3",since))
	end	 <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&ey=\\1&em=\\2&ed=\\3",date.end))

	if(!any(time.interval==c('d','w','m'))) stop("Invalid time.interval value")
	
	extractQuoteTable <- function(r,type){
		if(type %in% c("fund","fx")){
			tbl <- r[[2]][[2]][[7]][[3]][[3]][[9]][[2]]
		}
		else{
			tbl <- r[[2]][[2]][[7]][[3]][[3]][[10]][[2]]
		}
		return(tbl)
	}
	
	while( result.num >= 51 ){
		start.num <- start.num + 1
		quote.table <- NULL
		quote.url <- paste('http://info.finance.yahoo.co.jp/history/?code=',x,start,end,'&p=',start.num,'&tm=',substr(time.interval,1,1),sep="")
	
		#try( r <- xmlRoot(htmlTreeParse(quote.url,error=xmlErrorCumulator(immediate=F))), TRUE)	# これだと取得時にエラーが出た。。
		try(r<-htmlParse(quote.url))
		if( is.null(r) ) stop(paste("Can not access :", quote.url))

		#try( quote.table <- r[[2]][[1]][[1]][[16]][[1]][[1]][[1]][[4]][[1]][[1]][[1]], TRUE )
		#try( quote.table <- extractQuoteTable(r,type), TRUE )
		try( quote.table <- xpathApply(r,"//table")[[2]], TRUE )
		
		if( is.null(quote.table) ){
			if( is.null(financial.data) ){
				stop(paste("Can not quote :", x))
			}else{
				 financial.data <- financial.data[order(financial.data$date),]
				 return(financial.data)
			}
		}

		size <- xmlSize(quote.table)
		for(i in 2:size){
			financial.data <- rbind(financial.data,function.financialproduct(quote.table[[i]]))
		}
		
		result.num <- xmlSize(quote.table)
		Sys.sleep(1)
	}
	financial.data <- financial.data[order(financial.data$date),]
	return(financial.data)	
}
#convert string formart date to POSIXct object
convertToDate <- function(date.string,time.interval)
{
	#data format is different between monthly and dialy or weekly
	if(any(time.interval==c('d','w'))){
		result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-\\5",date.string)
	}else if(time.interval=='m'){
		result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-01",date.string)
	}
	return(as.POSIXct(result))
}
#convert string to number.
as.number <- function(string)
{
	return(as.double(as.character(gsub("[^0-9.]", "",string))))
}
#return end of month date.
endOfMonth <- function(date.obj)
{
	startOfMonth		 <- as.Date(format(date.obj,"%Y%m01"),"%Y%m%d")
	startOfNextMonth <- as.Date(format(startOfMonth+31,"%Y%m01"),"%Y%m%d")
	return(startOfNextMonth-1)
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

library(RFinanceYJ)

#API

quoteStockTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')

{

time.interval <- substr(time.interval,1,1)

function.stock <- function(quote.table.item){

if( xmlSize(quote.table.item) < 5) return(NULL)

d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)

o <- as.number(xmlValue(quote.table.item[[2]]))

h <- as.number(xmlValue(quote.table.item[[3]]))

l <- as.number(xmlValue(quote.table.item[[4]]))

c <- as.number(xmlValue(quote.table.item[[5]]))

v <- ifelse(xmlSize(quote.table.item) >= 6,as.number(xmlValue(quote.table.item[[6]])),0)

a <- ifelse(xmlSize(quote.table.item) >= 7,as.number(xmlValue(quote.table.item[[7]])),0)

return(data.frame(date=d,open=o,high=h,low=l,close=c,volume=v, adj_close=a))

}

return(quoteTsData(x,function.stock,since,start.num,date.end,time.interval,type="stock"))

}

quoteFundTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')

{

time.interval <- substr(time.interval,1,1)

function.fund <- function(quote.table.item){

d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)

if(time.interval=='monthly'){

d <- endOfMonth(d)

}

c <- as.number(xmlValue(quote.table.item[[2]]))

v <- as.number(xmlValue(quote.table.item[[3]]))

return(data.frame(date=d,constant.value=c,NAV=v))

}

return(quoteTsData(x,function.fund,since,start.num,date.end,time.interval,type="fund"))

}

quoteFXTsData <- function(x, since=NULL,start.num=0,date.end=NULL,time.interval='daily')

{

time.interval <- substr(time.interval,1,1)

function.fx <- function(quote.table.item){

d <- convertToDate(xmlValue(quote.table.item[[1]]),time.interval)

o <- as.number(xmlValue(quote.table.item[[2]]))

h <- as.number(xmlValue(quote.table.item[[3]]))

l <- as.number(xmlValue(quote.table.item[[4]]))

c <- as.number(xmlValue(quote.table.item[[5]]))

return(data.frame(date=d,open=o,high=h,low=l,close=c))

}

return(quoteTsData(x,function.fx,since,start.num,date.end,time.interval,type="fx"))

}

###### private functions #####

#get time series data from Yahoo! Finance.

quoteTsData <- function(x,function.financialproduct,since,start.num,date.end,time.interval,type="stock"){

r <- NULL

result.num <- 51

financial.data <- data.frame(NULL)

#start <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&c=\\1&a=\\2&b=\\3",since))

#end <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&f=\\1&d=\\2&e=\\3",date.end))

start <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&sy=\\1&sm=\\2&sd=\\3",since))

end <- (gsub("([0-9]{4,4})-([0-9]{2,2})-([0-9]{2,2})","&ey=\\1&em=\\2&ed=\\3",date.end))

if(!any(time.interval==c('d','w','m'))) stop("Invalid time.interval value")

extractQuoteTable <- function(r,type){

if(type %in% c("fund","fx")){

tbl <- r[[2]][[2]][[7]][[3]][[3]][[9]][[2]]

}

else{

tbl <- r[[2]][[2]][[7]][[3]][[3]][[10]][[2]]

}

return(tbl)

}

while( result.num >= 51 ){

start.num <- start.num + 1

quote.table <- NULL

quote.url <- paste('http://info.finance.yahoo.co.jp/history/?code=',x,start,end,'&p=',start.num,'&tm=',substr(time.interval,1,1),sep="")

#try( r <- xmlRoot(htmlTreeParse(quote.url,error=xmlErrorCumulator(immediate=F))), TRUE) # これだと取得時にエラーが出た。。

try(r<-htmlParse(quote.url))

if( is.null(r) ) stop(paste("Can not access :", quote.url))

#try( quote.table <- r[[2]][[1]][[1]][[16]][[1]][[1]][[1]][[4]][[1]][[1]][[1]], TRUE )

#try( quote.table <- extractQuoteTable(r,type), TRUE )

try( quote.table <- xpathApply(r,"//table")[[2]], TRUE )

if( is.null(quote.table) ){

if( is.null(financial.data) ){

stop(paste("Can not quote :", x))

}else{

financial.data <- financial.data[order(financial.data$date),]

return(financial.data)

}

size <- xmlSize(quote.table)

for(i in 2:size){

financial.data <- rbind(financial.data,function.financialproduct(quote.table[[i]]))

}

result.num <- xmlSize(quote.table)

Sys.sleep(1)

}

financial.data <- financial.data[order(financial.data$date),]

return(financial.data)

}

#convert string formart date to POSIXct object

convertToDate <- function(date.string,time.interval)

{

#data format is different between monthly and dialy or weekly

if(any(time.interval==c('d','w'))){

result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-\\5",date.string)

}else if(time.interval=='m'){

result <- gsub("^([0-9]{4})([^0-9]+)([0-9]{1,2})([^0-9]+)","\\1-\\3-01",date.string)

}

return(as.POSIXct(result))

}

#convert string to number.

as.number <- function(string)

{

return(as.double(as.character(gsub("[^0-9.]", "",string))))

}

#return end of month date.

endOfMonth <- function(date.obj)

{

startOfMonth <- as.Date(format(date.obj,"%Y%m01"),"%Y%m%d")

startOfNextMonth <- as.Date(format(startOfMonth+31,"%Y%m01"),"%Y%m%d")

return(startOfNextMonth-1)

}

実行結果

> quoteStockTsData("6758.t",since="2010-01-01")
					 date	 open	 high		low	close		volume adj_close
1136 2010-01-04 2700.0 2744.0 2694.0 2731.0	 4004500		2731.0
1135 2010-01-05 2781.0 2782.0 2704.0 2719.0	 4894300		2719.0
1134 2010-01-06 2719.0 2757.0 2699.0 2744.0	 4270900		2744.0
1133 2010-01-07 2750.0 2764.0 2723.0 2743.0	 2899600		2743.0
1132 2010-01-08 2785.0 2809.0 2769.0 2809.0	 6981100		2809.0
..

> quoteStockTsData("6758.t",since="2010-01-01")

date open high low close volume adj_close

1136 2010-01-04 2700.0 2744.0 2694.0 2731.0 4004500 2731.0

1135 2010-01-05 2781.0 2782.0 2704.0 2719.0 4894300 2719.0

1134 2010-01-06 2719.0 2757.0 2699.0 2744.0 4270900 2744.0

1133 2010-01-07 2750.0 2764.0 2723.0 2743.0 2899600 2743.0

1132 2010-01-08 2785.0 2809.0 2769.0 2809.0 6981100 2809.0

長いヒストリカルデータも何のその！！

2014.8.19

HirofumiYashima様の指摘により修正してみました

なお、実行環境はMacOS10．9のR version 3.0.3 です

2015.1.20

こちらの記事はYahooの仕様変更によりとれなくなってしまいました

http://d.hatena.ne.jp/anagotan/20150120

こちらを参照ください

“Rでチャートを書いてみる(5)” への6件のフィードバック

HirofumiYashima 2014-08-18
ご修正ありがとうございます！
実行してみたもですが、やはり、下記のエラーが再発してしまうようです（＞　＜）
HirofumiYashima 2014-08-18
ご修正ありがとうございます！
実行してみたもですが、やはり、下記のエラーが再発してしまうようです（＞　＜）
HirofumiYashima 2014-08-18
以下のとおりです (> <)
わたしのコピペミスかもしれません。。。
http://qiita.com/HirofumiYashima/items/4d62ddabca48d9d837ed
utsubo 2014-08-19
違う環境で実行すると同様のエラーが出てしまいました
どうやらHTMLをParseする際のエラーの模様。。
http://stackoverflow.com/questions/14957632/r-xpathapply-on-xmlnodeset-with-xml-package
この辺りを参考に修正してみました
HirofumiYashima 2014-08-19
R version 3.0.1 で正常に動作すること、確認させていただきました！
ご修正、ありがとうございました。
１点だけ、data.frame型で戻ってくる返り値の行番号が、降順に割り振られる（株価の古い日付行が、大きな数字になり、最直近の新しい日付の行が、１番の行番号になる）ようですが、こちらは意図されたとおりで間違いないでしょうか。
動作内容にはまったく支障のない行番号ですので、無視してかまわないものだと思っています（^ ^)/
moneycat 2014-09-22
ありがとう！

コメントは停止中です。