ラベル Google Earth の投稿を表示しています。 すべての投稿を表示
ラベル Google Earth の投稿を表示しています。 すべての投稿を表示

2015年7月30日木曜日

R と Google Earth ~等値線図の作成~

前回に引き続き今回も Google Earth を扱いたいと思います

緯度経度情報を含む平面的なデータがあるとき、やはり真っ先に「俯瞰的に情報を把握したい」と思うのではないでしょうか。
そんなときに便利なのが等値線図 (コンター) ですよね。

でもこの等値線図、どうやって描きますか?
Surfer に GMTこの他にも様々なソフトがありますよね

もちろん R にも contour() という関数があり、等値線図を描くことができます。しかし、contour() を利用する前には補間をしておかなければなりません。補間の種類は色々とあるのですが、今回はクリギングができるパッケージを紹介したいと思います。

そして等値線図を R で表示しただけでは、海岸線が表示されていないので、あまり意味がありません。
そこで、今回は、Google Earth に等値線図を貼り付けるコードを紹介したいと思います。

出力イメージはこんな感じです。



なにはともあれデータが必要なのでこちらのテストデータをご利用下さい。
このデータは前回 Google Earth にプロットした九州西部の AMeDAS の緯度経度データと気温のデータです
データは 2014 年 3 月 30 日 12:00 のものです。

必要となるパッケージは automap です。
それと表示用の Google Earth です


使い方 ---------------------------
はじめにプログラム上部に、変更可能な変数があるので、任意の値を設定して下さい。
xgn = 300 はテストデータの西端と東端の間を 300 等分したときの点という意味です。
ygn は北端と南端で同様のことを意味します
つまり、この値を増やすほど詳細に計算されますが、計算速度は当然落ちますし、結果のファイルも重たくなります。

これに関連して、reso で解像度を設定できます。reso = 1 のときは 480×480 ピクセルです。
これもあまりに大きくすると、綺麗ですが重たくなりますので、使用している PC のスペックに合わせて設定して下さい。

色の設定ではデフォルトで、白 → オレンジ に変わるようになっています。
R で指定できる色に変更可能ですし、カンマで切って繋げれば、複数設定することもできます。
例えば c("white", "orange", "red") な感じ

プログラムを実行すると、ファイル選択ウィンドウが開くので、テストデータあるいはご自分で作成したファイルを選んで下さい。
以上です。

読み込んだファイルがあるフォルダに「ファイル名_等値線図.kml」というファイルができているはずです。
これを開くと等値線図が見れます。


プログラムについて ---------------
補間に関しては、パッケージ automap の関数 autoKrige() に任せっきりです。
どのようなモデルで補間するかとかも指定できるので automap.pdf で確認して下さい。
デフォルトでは model="Gau" です。
途中でバリオグラムが表示されるので、正しく補間されているか確認して下さい。

特に自作関数は使ってないので、気になるところは一行ずつ実行してもらうと中身が分かると思います。



#作成日時 : 9:18 2011/07/06
 #作成者名:T. Nakano
 rm(list=ls())
 gc();gc()

 library(automap)
 # ////////////////  Google Earth で等値線図作成  ///////////////////

 # 変更可 -----------------------------------------------------------
 # 等値線の本数 ----------
 LN = 10

 # 等値線の値の桁数 -----
 dgt = 1

 # 外挿計算 --------------
 extrapolate = "off"          # on or off

 # 補間点数 --------------
 xgn = 300                       # x 軸方向に xgn 分割する
 ygn = 300                       # y 軸方向に ygn 分割する

 # 解像度 ----------------
 reso = 2

 # 色の設定 --------------
 cols = colorRamp(c("white", "orange"))

 # データの読込み -------------------------------------------------
 library(tcltk)
 fileName <- tclvalue(tkgetOpenFile())
 act1 <- unlist(strsplit(fileName,"/"))
 act1 <- act1[-length(act1)]

 directory <- NULL
 if(length(act1)!=1){
 for(i in 1:(length(act1)-1)){
 directory <- paste(directory,act1[i],"/",sep="")
 }
 }
 directory <- paste(directory,act1[length(act1)],sep="")
 setwd(directory)
 SRX <- read.csv(fileName, header=T)

 DT <- data.frame(x=SRX$LON, y=SRX$LAT, data=SRX$DATA)
 coordinates(DT) =~ x+y

 # 補間地点の緯度経度整理 -----------------------------------------
 Xst <- seq(min(SRX$LON), max(SRX$LON), length=xgn)
 Yst <- seq(min(SRX$LAT), max(SRX$LAT), length=ygn)

 Xip <- rep(Xst, each=length(Yst))
 Yip <- rep(Yst, length(Xst))
 Ncode <- data.frame(x=Xip, y=Yip)

 # クリギング -------------------------------------------------------
 gridded(Ncode)=~x+y
 kriging_result <- autoKrige(data~1, DT, Ncode, model="Gau")
 WR <- data.frame(LON=Xip, LAT=Yip, PRED=kriging_result$krige_output$var1.pred)
 plot(kriging_result)

 # 凸閉包で外挿除外 -------------------------------------------------
 if(extrapolate=="off"){
 act1 <- data.frame(x=SRX$LON, y=SRX$LAT)
 hullpnt <- chull(act1)
 hullpnt <- c(hullpnt,hullpnt[1])
 poly <- act1[hullpnt,]
 pip <- point.in.polygon(Xip,Yip,poly$x,poly$y)
 hullDT <- data.frame(x=Xip,y=Yip,pip)
 WR[which(hullDT$pip == 0), 3] <- NA
 }

 # コンター作成 ----------------------------------------------------
 con.x <- unique(WR$LON)
 con.y <- unique(WR$LAT)
 con.z <- matrix(WR$PRED, ncol=length(con.x), byrow=T)

 # 出力設定 ----------
 xlength <- max(SRX$LON)-min(SRX$LON)               # デバイスサイズの計算
 ylength <- max(SRX$LAT)-min(SRX$LAT)
 xratio <- xlength/xlength
 yratio <- ylength/xlength
 png("filledcontour_kirg.png", xratio*480*reso, yratio*480*reso)
 par(xaxs = "i", yaxs = "i", mar=c(0,0,0,0), omi=c(0,0,0,0), bg="transparent", xaxt="n", yaxt="n")

 # コンター作成 ------
 image(con.x, con.y, con.z, col=rgb(cols(0:(LN-1)/(LN-1))/255), bg="transparent", bty="n")
 maxn <- max(con.z[which(!is.na(con.z))])
 minn <- min(con.z[which(!is.na(con.z))])
 LV <- round(seq(minn, maxn, length=LN+1), dgt)
 contour(con.x, con.y, con.z, levels=LV, add=T, labcex=reso)
 points(SRX$LON, SRX$LAT, pch=16, col=4, cex=reso)

 dev.off()

 # KML 作成 ----------------------------------------------------------
 GEfn <- paste(unlist(strsplit(fileName, ".csv")), "_等値線図.kml", sep="")
 sink(GEfn)
 cat('<?xml version="1.0" encoding="UTF-8"?>
 <kml xmlns="http://www.opengis.net/kml/2.2">
 <GroundOverlay>
 <name>Contour</name>
 <color>5cffffff</color>
 <Icon>
 <href>filledcontour_kirg.png</href>
 <viewRefreshTime>0</viewRefreshTime>
 </Icon>
 <altitude>300</altitude>
 <altitudeMode>clampToGround</altitudeMode>
 <LatLonBox id="contour">
 <north>',max(SRX$LAT),'</north>
 <south>',min(SRX$LAT),'</south>
 <east>',max(SRX$LON),'</east>
 <west>',min(SRX$LON),'</west>
 </LatLonBox>
 </GroundOverlay>
 </kml>', sep='')
 sink()


2015年6月27日土曜日

R と Google Earth ~地点図の作成~

今回は R と Goole Earth の連携をご紹介したいと思います
というのも、緯度経度情報は意外とよく使うわりには一括で表示したりするのが面倒くさい!と感じたからです。

例えば、手元に多数の緯度経度データがあり、その位置関係を確認したい、他人に説明するときの簡単な資料を作りたい、というときに、Google Earth の [追加] → [目印] で一個一個入力なんてしてられないですよね。

ということで、R を使って Google Earth に地点を一括入力するプログラムを作りました。
出力イメージはこんな感じです。



今回使用した緯度経度データは、気象庁で公開されている九州西部の AMeDAS の設置場所です。
緯度経度データを整理したものをこちらに置いておきますので、テストデータとしてご使用下さい。


テストデータはこんな感じで並んでいます。

地点名 緯度 経度
Nagasaki 32.73333 129.8667
Nomozaki 32.57833 129.74
Ohmura 32.91667 129.9133
Ohseto 32.94833 129.6333
Sasebo 33.15833 129.7267

注意
・地点名に日本語は使えないようです (kml 形式の関係かな?)。
・緯度経度データは度表示 (10進法) です。



使い方
以下のプログラムを実行すると、ファイル選択ウィンドウが開くので、テストデータあるいはご自分で作成したファイルを選んで下さい。
以上です。

読み込んだファイルがあるフォルダに「ファイル名_地点図.kml」というファイルができているはずです。
これを開くと Google Earth が起動し地点図が表示されます




#作成日時 : 11:09 2011-07-05
#作成者名:T.Nakano
rm(list=ls())
gc();gc()

library(tcltk)
#////////////////  Google Earth で地点図作成  ///////////////////////////////////////////////////////////////////////
# 関数の設定 ----------------------------------------------------------# 地点情報を kml ファイルに変換する関数 -------------------------------
fun_KML <- function(地点名,緯度,経度,PointSize=0.8){
cat('<Placemark>
<name>',地点名,'</name>
<Point>
<coordinates>',経度,',',緯度,',0</coordinates>
</Point>
<Style>
<IconStyle>
<Icon>
<href>http://maps.google.com/mapfiles/kml/shapes/shaded_dot.png</href>
</Icon>
<color>ff0000ff</color>
<scale>',PointSize,'</scale>
</IconStyle>
</Style>
</Placemark>','\n', sep='')
}

# データの読み込み ---------------------------------------------------
fileName <- tclvalue(tkgetOpenFile())
act1 <- unlist(strsplit(fileName,"/"))
act1 <- act1[-length(act1)]

directory <- NULL
for(i in 1:(length(act1)-1)){
directory <- paste(directory,act1[i],"/",sep="")
}
directory <- paste(directory,act1[length(act1)],sep="")
setwd(directory)
DT <- read.csv(fileName, header=T)
DT$地点名 <- as.character(DT$地点名)

# KML ファイル作成 ---------------------------------------------------
GEfn <- paste(unlist(strsplit(fileName, ".csv")), "_地点図.kml", sep="")
sink(GEfn)
cat('<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://www.opengis.net/kml/2.2">
<Folder>','\n')
for(i in 1:length(DT$緯度)){
fun_KML(DT$地点名[i],DT$緯度[i],DT$経度[i])
}
cat('</Folder>
</kml>','\n')
sink()