医療機関リスト＋地図をHTMLレポートにする

医療機関の住所ってのはなぜかPDFで公開されていたりして非常に加工しにくい。
しかしこれをPerlで加工して公開してくださっている方がいる。
保険医療機関一覧データ保管庫

せっかく公開されているので地図にプロットしてみたい。
今回は自分の住所を入力して、その近くの医療機関をリストアップ＋プロットという形で最終的にHTMLに出力する形とした。
あとで詳細は書く。

library(RCurl)
library(bitops)
library(XML)

#上記サイトの20110301.zipを今回用いた。
#ダウンロードしてきた医療機関データを読み込む(今回はdata1.tsvの100件のみ)
d <- read.delim("data1.tsv", nrows=100,stringsAsFactors=FALSE)

#googleジオコーディングを利用して緯度と経度を取得する

locationdata <- d$住所

#取得関数の定義
getGIS <- function(locationdata){
 data <-  NULL
 for(count in 1:length(locationdata)){
　　  location <- locationdata[count]
　　　　  if(Sys.getlocale("LC_CTYPE")=="Japanese_Japan.932"){
　　　　  Encodelocation <-paste(c("",charToRaw(iconv(location,"CP932","UTF-8"))),collapse="%")
　　　　  }else{
　　　　  Encodelocation <-paste(c("",charToRaw(location)),collapse="%")
　　　　  }
　　  url <- paste("http://maps.google.com/maps/api/geocode/xml?address=",Encodelocation,"&sensor=false", sep="")
　　  xml <- getURL(url)
　　  lat <-as.numeric(xmlValue(xmlRoot(xmlTreeParse(xml))[["result"]][["geometry"]][["location"]][["lat"]]))
　　  lon <-as.numeric(xmlValue(xmlRoot(xmlTreeParse(xml))[["result"]][["geometry"]][["location"]][["lng"]]))
　　  data0 <- data.frame(lat=lat, lon=lon, stringsAsFactors=FALSE)
　　  data <- rbind(data, data0)
   }
 return(data)
 }

latlon <- getGIS(locationdata)

d2 <- cbind(d, latlon)
d2 <- d2[!is.na(d2$lat), ]

#自分の住所を入力する→緯度経度への変換

myaddress <- "松山市大手町1丁目1番1号"
mylatlon <- getGIS(myaddress)

#その範囲に入る医療機関を抽出する→今回は住所の緯度経度+0.01の範囲
myrange <- 0.01
d3 <- d2[d2$lat >= (mylatlon$lat-myrange) & d2$lon >=(mylatlon$lon-myrange) & d2$lat <=(mylatlon$lat+myrange) & d2$lon <=(mylatlon$lon+myrange), ]


###医療機関を表示する（医科、歯科、薬局）→医療機関リスト＋地図（RgoogleMapsで自分の住所を中心に）

#google static map API用にマーカーを作成（自分の住所はマーカーの色が青になるように指定）

library(RgoogleMaps)
mymarkers <- ""
 for(i in 1:nrow(d3)){
 loc <- paste(d3[i,"lat"],d3[i,"lon"], sep=",")
 lab <- paste("label:", LETTERS[i], sep="")
 m1 <- paste(lab, loc, sep="|")
 mymarkers <- paste(mymarkers, m1, sep="&markers=")
 }
 myloc <- paste(mylatlon, collapse=",")
 myloc <- paste("&markers=color:blue|", myloc, sep="")
 mymarkers <- paste(myloc, mymarkers, sep="")
GetMap(markers = mymarkers, destfile = "Mymap.png") #メッセージがでるが気にせずyを押す

###マップと住所を整形してレポートをHTMLで出力

output <- d3[, c(6, 7, 8)] #施設名、郵便番号、住所を出力用に抽出
rownames(output) <- LETTERS[1:nrow(d3)] #マーカーのアルファベットに合わせる

library(hwriter)
p <- openPage("report.html", charset="shift-jis") #医療機関データの文字コードがshift-jisであるため
img <- hwriteImage('Mymap.png', br=FALSE, width=500)
doc <- hwrite(output)
hwrite(c(img, doc), p, border=0)
closePage(p)

#これで作業ディレクトリ（getwd()で確認可能）にHTMLレポートが出力されているはず。