「Rを使ってYahoo!乗換案内から運賃や所要時間,乗換回数を取得するコード書いた」をscrapeRで書いてみたよ

こちらの話。
Rを使ってYahoo!乗換案内から運賃や所要時間,乗換回数を取得するコード書いた - Fire and Motion
Rubyでもなく、Perlでもなく、Rでスクレイピングしようというコンセプトがすばらしいです。熱い。
あちらのサイトではスクレイピング部分が結構大変な事になってるので、Rでももっと簡単にスクレイピングできるよ!と思ってちょっと書いてみました。
あとは個人的な趣味として、for文とかif文を使わないでapply系をつかってます。やっぱりRの醍醐味はapplyでしょう(?)。

library(scrapeR)

#出発駅と到着駅ベクトル
station1 <- c("渋谷","表参道", "外苑前", "青山一丁目", "赤坂見附", "溜池山王", "虎ノ門", "新橋", "銀座", "京橋", "日本橋", "三越前", "神田", "末広町", "上野広小路", "上野", "稲荷町", "田原町", "浅草", "渋谷")
station2 <- c("品川","大崎", "五反田", "目黒", "恵比寿", "渋谷", "原宿", "代々木", "新宿", "新大久保", "高田馬場", "目白", "池袋", "大塚", "巣鴨", "駒込", "田端", "西日暮里", "日暮里", "鶯谷")

url.escape <- function(str){
    curlEscape(iconv(str, "CP932","UTF-8"))
}

xmlValue.dec <- function(el){
    iconv(xmlValue(el), "UTF-8", "CP932")
}

# get the first interger value from XML text node
xmlFirstIntValue <- function(el){
    # convert to CP932 to avoid "input string * is invalid in this locale"
    sub("([[:digit:]]+).*", "\\1", xmlValue.dec(el))
}

# HTML scraping
transit.search <- function(from, to){
    url  <- sprintf("http://transit.map.yahoo.co.jp/search/result?from=%s&to=%s", url.escape(from), url.escape(to))
    page <- scrape(url)

    Cost.v     <- xpathSApply(page[[1]], '//span[@class="route-fare-on" or @class="route-fare-off"]', xmlFirstIntValue)[[1]]
    Transfer.v <- xpathSApply(page[[1]], '//span[@class="route-transfer-on" or @class="route-transfer-off"]', xmlFirstIntValue)[[1]]
    Time.str   <- xpathSApply(page[[1]], '//div[@class="infomation"]//dd', xmlValue.dec)[[1]]
    Time       <- strsplit(gsub("^ +| +$", "", gsub("[^[:digit:]]", ' ', Time.str)), " +")[[1]]
    Time.in    <- Time[2]
    Time.out   <- Time[3]
    sprintf("%s %s %s %s %s %s", from, to, Cost.v, Time.in, Time.out, Transfer.v)
}

# create data frame for result
con    <- textConnection(mapply(transit.search, station1, station2))
result <- read.table(con)
close(con)

colnames(result) <- c("Origin", "Destination", "Cost", "Timein", "Timeout", "Transfer")
result

結構すっきりした!

あとは気になる点をいくつか。

Rの文字列操作はやっぱり癖があるなー。せっかくの perl 拡張も日本語だと何故かエラーになってしまうし。

> sub("ペロペロ", "ちゅっちゅ", "あやにゃんペロペロ", perl=T)
 以下にエラー sub("ペロペロ", "ちゅっちゅ", "あやにゃんペロペロ", perl = T) : 
   入力文字列 1 はこのロケールでは不適切です 
> sub("lick", "kiss", "lick your Ayanyan", perl=T)
[1] "kiss your Ayanyan"

それと、apply系でデータフレームを返す方法が分からなかったので、文字列で返した後でread.tableしてるのが気に入らないですね。うーん。どうにかならないかな・・・。

とはいえ、概ね満足なかんじ。

追記

apply系関数でデータフレームを返す方法について調べました。満足。
apply系関数でデータフレームを返したいときは plyr パッケージが便利 - XXXannex