mikeo_410
  1. 2.地球
    1. 1.地球楕円体上の点
    2. 2.地球儀と楕円体の描画
    3. 3.3Dの直線と平面
    4. 4.卯酉線
    5. 5.楕円の標準形
    6. 6.5点で決まる楕円
    7. 7.曲率半径と平均曲率
    8. A1.地図、地球儀(Rスクリプト、データ)
    9. A2. 付録6.計算式集の公式

地図、地球儀(Rスクリプト、データ)

地球儀」は、Rスクリプトで地球儀を描いて、rglwidget() で保存したものです。htmlファイルとサブフォルダが作られます。RGLのウィンドウと同様にマウスで動きます。

その元になった地球儀は、どうやって書いたのかと、10年前の記事を引き出します。

1. RGLの図をブラウザで表示すること

RGLで3Dの図を描いて動かして確認します。それをWEBページで説明するために何枚かの動かない図にします。しかし、動かない図だけを見た人には伝わらないだろうとも思います。

そこで、いつもブラウザにRGLの動く図が出せないものかと思っていました。ときどきRスクリプトの記事に「WebGL」と言う文字列を見て、「WebRGL」というものがあるらしいと思い込んでいました。

今回知ったのは、RGLウインドウに表示しているものを、rglwidget() を呼び出せばHTMLになるというものです。

  1. C:\USERS\xxx\APPDATA\LOCAL\TEMP\RTMPxxx\VIEWHTMLxxx
  2. │  index.html
  3. └─lib
  4.     ├─CanvasMatrix4-0.108.3
  5.     │      CanvasMatrix.src.js
  6.     │
  7.     ├─htmlwidgets-1.5.4
  8.     │      htmlwidgets.js
  9.     │
  10.     ├─rglWebGL-binding-0.108.3
  11.     │      rglWebGL.js
  12.     │
  13.     └─rglwidgetClass-0.108.3
  14.             axes.src.js
  15.             buffer.src.js
  16.             controls.src.js
  17.             draw.src.js
  18.             init.src.js
  19.             mouse.src.js
  20.             pieces.src.js
  21.             pretty.src.js
  22.             projection.src.js
  23.             rgl.css
  24.             rglClass.src.js
  25.             rglTimer.src.js
  26.             selection.src.js
  27.             shaders.src.js
  28.             subscenes.src.js
  29.             textures.src.js
  30.             utils.src.js

rglwidget() を実行すると、ブラウザが起動して、上のようなフォルダの index.html が開かれます。

index.html は 3.9MB と大きく、./lib 以下は 272KBです。

これが今のところ知っている全てです。

2. 地球儀を描くスクリプト

元の記事は冗長なので、先に地球儀を描いたスクリプトを示します。

  1. source("lib/DrawEarth.r")
  2. EARTH <- DrawEarth() # 地球の描画
  3. # mapdataパッケージのworld,riversを3Dで表示
  4. library(mapdata)
  5. d <- map("world",plot=F)       # 行政区画(x:経度,y:緯度)
  6. d <- degXYZ(d$y,d$x,EARTH$b)   # XYZ座標系に変換
  7. lines3d(d[,1],d[,2],d[,3],col="gray40",add=T)
  8. d <- map("rivers",plot=F)      # 河川
  9. d <- degXYZ(d$y,d$x,EARTH$b)   # XYZ座標系に変換
  10. lines3d(d[,1],d[,2],d[,3],col="paleturquoise",add=T)

DrawEarth.r は以下の通りです。

  1. library(rgl)
  2. library(matlib) # vectors3d()
  3. source("lib/ellipsoid.r")
  4. DrawEarth <- function(f=1/298.257222101){
  5.   b <- 1-f
  6.   clear3d(type="lights"); light3d(specular="black")
  7.   view3d(0) # デフォルトでは西半球が描かれ見えないので
  8.   plot3d(ellipsoid(a=1,b=1,c=b),xlab="",ylab="",zlab="",
  9.          axes=F, col="ivory")
  10.   EquatorLine(b=b) # 赤道
  11.   for(u in seq(0,150,by=30)/180*pi)
  12.     LongitudeLine(u,b=b) # 経線
  13.   for(u in seq(-80,80,by=20)/180*pi)
  14.     LatitudeLine(u,b=b)  # 緯線
  15.   invisible(list(
  16.       a=1, a_=6378137,
  17.       b=b,
  18.       f=f
  19.       ))
  20. }
  21. #------------------------------------------------------
  22. # 弧度で与えられた経度と緯度(地理緯度)からXYZ座標を計算
  23. radXYZ <- function(φ,λ,b)
  24. {
  25.     β <- atan(b*tan(φ))
  26.     cbind(cos(β)*cos(λ),cos(β)*sin(λ),b*sin(β))
  27. }
  28. #------------------------------------------------------
  29. # 度で与えられた経度と緯度(地理緯度)からXYZ座標を計算
  30. degXYZ <- function(latitude,longitude, b) #!!! 経度、緯度の順
  31. { radXYZ(latitude*pi/180, longitude*pi/180, b) }
  32. #------------------------------------------------------
  33. # 赤道を描く(degree)
  34. EquatorLine <- function(b,col="red",lwd=1)
  35. { LatitudeLine(0,b,col="red") }
  36. #------------------------------------------------------
  37. # 緯線を描く
  38. LatitudeLine <- function(φ,b,col="khaki",lwd=1)
  39. {
  40.   d <- radXYZ(rep(φ,360),seq(0,2*pi,length.out=360),b)
  41.   lines3d(d[,1],d[,2],d[,3],col=col,lwd=lwd,add=T)
  42. }
  43. #------------------------------------------------------
  44. # 経線を描く
  45. LongitudeLine <- function(λ,b,col="khaki",lwd=1)
  46. {
  47.   d <- radXYZ(seq(-pi/2,pi/2,length.out=180),rep(λ,180),b)
  48.   lines3d(d[,1],d[,2],d[,3],col=col,lwd=lwd,add=T)
  49.   d <- radXYZ(seq(-pi/2,pi/2,length.out=180),rep(λ+pi,180),b)
  50.   lines3d(d[,1],d[,2],d[,3],col=col,lwd=lwd,add=T)
  51. }
  52. #------------------------------------------------------

ellipsoid.r は以下の通りです。

  1. # cdaパッケージがインストールできなかったので止むなく
  2. ellipsoid <- function (
  3.             x=0, y=0, z=0,
  4.             a = 1, b=1, c=1,
  5.             phi=0, theta=0, psi=0,
  6.             subdivide = 3, smooth = TRUE, ...) {
  7.   sphere <- rgl::subdivision3d(rgl::cube3d(...), subdivide)
  8.   class(sphere) <- c("mesh3d","shape3d")
  9.   norm <- sqrt( sphere$vb[1, ]^2 +
  10.                 sphere$vb[2, ]^2 +
  11.                 sphere$vb[3, ]^2 )
  12.   for (i in 1:3) sphere$vb[i, ] <- sphere$vb[i, ]/norm
  13.   sphere$vb[4, ] <- 1
  14.   sphere$normals <- sphere$vb
  15.   result <- rgl::scale3d(sphere, a,b,c)
  16.   rotM <- cpp_euler_passive(phi,theta,psi)
  17.   result <- rgl::rotate3d(result,matrix=rotM)
  18.   result <- rgl::translate3d(result, x,y,z)
  19.   invisible(result)
  20. }
  21. #
  22. cpp_euler_passive <- function(phi, theta, psi) {
  23.     Rot <- matrix(rep(0,9),nrow=3,ncol=3);
  24.     cosphi = cos(phi); cospsi = cos(psi); costheta = cos(theta);
  25.     sinphi = sin(phi); sinpsi = sin(psi); sintheta = sin(theta);
  26.     Rot[1,1] = cosphi*costheta*cospsi - sinphi*sinpsi;
  27.     Rot[1,2] = sinphi*costheta*cospsi + cosphi*sinpsi;
  28.     Rot[1,3] = -sintheta*cospsi;
  29.     Rot[2,1] = -cosphi*costheta*sinpsi - sinphi*cospsi;
  30.     Rot[2,2] = -sinphi*costheta*sinpsi + cosphi*cospsi;
  31.     Rot[2,3] = sintheta*sinpsi;
  32.     Rot[3,1] = cosphi*sintheta;
  33.     Rot[3,2] = sinphi*sintheta;
  34.     Rot[3,3] = costheta;
  35.     return(Rot);
  36.   }
3. Global Administrative Areas

  国名と形式を選んで地図データがダウンロードできます。形式には R があります。R形式は .RData(Rの作業スペース)です。Rで「ファイル」「作業スペースの読み込み」で読み込めます。

  iraq を選んでダウンロードして読み込んで見ると単一のオブジェクト gadm が含まれます。plot(gadm)で表示できます。 ダウンロードできるファイルはレベル0、1、2と3種あり、レベル0は国境線のみでした。後は行政区画の細かさのようです。

  河川や湖沼は描かれません。

  http://www.gadm.org/

  .RData 以外の形式は、Shapefile、 ESRI file geodatabase、ESRI personal geodatabase、Google Earth  KML があります。

  ESRI 社の ArcGIS や ArcMAP が実質的な業界標準のようです。

  QGISではShapefile、ESRI personal geodatabase を「レイヤの追加」で読み込むことが出来ます。

  ESRI personal geodatabase は単一の .mdb ファイルです。

  Shapefile、 ESRI file geodatabaseは複数のファイルから構成されています。

  Gadmには国別以外に「Whole World」があります。Shapefile、 ESRI file geodatabase、ESRI personal geodatabase の解凍した後の大きさは、それぞれ 1.4GB、608MB、1.19GBでした。

  R言語には、rgdal、PBSmapping、sp、maptools、gpclib と言ったパッケージがあり、これらのデータが扱えることになっています。

  しかし、一度にデータフレームに読み込むもので、2GB程度のパソコンでは不可能でした。

  ESRI personal geodatabase は .mdb なのでAccess 等で内容が見られます。データは海岸線や国境、行政区画などのように階層をなしていないようです。データは最小の行政区画のポリゴンの集合です。これを国名や国、地域コードで引くことで、国別や地域の地図を描きます。ポリゴンにはいくつかの属性が付与されていますが図形を描く際のレイヤの替わりになるものはないようです。ENGTYPE_1には Province や State と記されていますが、各国には1通りしかないので英語で何と呼ばれるかの参照にしかなりません。州名は有意義な情報で中国語表記もあります。これらの属性は元の情報にあったものを残したもので統一的な基準で含まれている訳ではないものと思います。

 R言語には地図情報を扱ういくつかのパッケージがあります。  sp、maptools が基本的なパッケージのようです。shapefile形式でIRQ_adm.zipをダウンロードして試してみました。 shapefile を読み込む関数は複数あり、線画、ポリゴンなどで読み込むようです。

  1. library(maptools)
  2. #a <- readShapeLine("IRQ_adm/IRQ_adm2.shp")
  3. #a <- readShapePoly("IRQ_adm2.shp")
  4. a <- readShapeSpatial("IRQ_adm/IRQ_adm2.shp")
  5. par(mar=c(0,0,0,0))
  6. plot(a)          # 地図を描く

 読み込んだものは plot() で描画できます。

  国境線や海岸線が識別できる訳ではないので、国境を書くにはポリゴンをマージすることになります。gpclib にはその機能があるようです。ポリゴンデータを "gpc.poly" と言う型にして union() を呼び出します。

  1. library(gpclib)
  2. LM <- a@bbox              # 図形の範囲
  3. pos <- slot(a,"polygons") # データフレーム中の図形部分
  4. n <- length(pos)          # 図形データの総数
  5. u <- as(pos[[1]]@Polygons[[1]]@coords,"gpc.poly")
  6. for(i in 1:n)
  7. {
  8.   po <- as(pos[[i]]@Polygons[[1]]@coords,"gpc.poly")
  9.   u <- union(u,po)
  10. }
  11. par(mar=c(0,0,0,0))
  12. plot(u)

  ポリゴンには11の属性が与えられています。しかし、有意そうなのは行政区画の名前だけです。行政区画の名前を含めて、属性はデータ作成時に元データから与えられたものだと思います。国が替われば属性の意味合いも変わるもので一律の基準で出来ているわけではないようです。

 行政区画で選択して部分的な図が描けます。

  1. par(mar=c(0,0,0,0))
  2. plot(0,0,col="white",xlim=LM["x",],ylim=LM["y",],
  3.      xlab="",ylab="",axes=F)
  4. for(i in which(a@data$NAME_2=="Basrah"    |
  5.                a@data$NAME_2=="Abu al Khasib" |
  6.                a@data$NAME_2=="Shatt Al Arab" |
  7.                a@data$NAME_2=="Chibayish" |
  8.                a@data$NAME_2=="As Salman" |
  9.                a@data$NAME_2=="Al Zubair"))
  10. {
  11.   polygon(pos[[i]]@Polygons[[1]]@coords)
  12. }
4. Whole World データ

  前述のように Global Administrative Areas は 2GB の実装のパソコンでは開けませんでした。QGISなどでは表示するだけはなんとか出来ますが操作は実用範囲外です。しかしメモリを足すだけで自由に地図が使えるならありがたいことだと思います。

  地図データとしては読めませんがデータベース(MDB)としては読めるので、地球を表すデータはどのようなものか gadm2.mdb を調べて置きます。(最大のテーブル gadm2 はフィールドを制限して部分的に読むことができますが全フィールド(*)を使うとR言語ごと落ちます。)

  まず、データは8バイトの浮動小数点数(double)です。地球楕円体(準拠楕円体)の赤道半径は 6,378,137 m です。メートルのスケールで、赤道の一周は8桁の数字です。したがって、4バイト(float)では不足なことは確かです。しかし、メートルのオーダーで見た現実の地球は常に変化しているのだと思います。また、描画精度の面でもdoubleの精度は冗長です。

  型を気にしないで済む点で double型は合理的な選択ですがプログラミング上は工夫の余地があります。R言語の演算精度は16桁程度のようです。

  gadm2.mdb の図形データの行数は 218,238 です。行は行政区画を表すもので、国名や行政区画名が振られています。行は複数のポリゴンで出来ています。行の図形データのサイズは112から9,007,976byteです。

  地球上の行政区画の総数は22万ほどのようです。

  行政区画には以下のような区分が設定されています。各国で付与した区分の英訳だと思います。国が異なれば意味合いも変わるものだと思います。

Autonomous Republic

Administrative Area

Administrative State

Arrondissement

Atoll

Automonous Region

Autonomous City

Autonomous Commune

Autonomous Community

Autonomous Island

Autonomous Monastic State

Autonomous Province

Autonomous Region

Autonomous Republic

Autonomous Sector

Autonomous Territory

Borough

Canton

Capital City

Capital District

Capital Metropolitan City

Capital Territory

Centrally Administered Area

Circuit

City

Commissiary

Commune

County

Department

Dependency

Development Region

Directly Governed City

District

District|Regencies

Division

Economic Prefecture

Emirate

Entity

Federal District

Governorate

Independent City

Independent Town

Indigenous Territory

Intendancy

Island

Island Council

Island

Group Island|Atoll

Kingdom

Lake

Metropolis

Metropolitan City

Municipality

Municipality|Governarate

Municipality|Prefecture

National Capital Area

National District

National Territory

Neutral City

Parish

Prefecture

Prefecture

Principality

Province

Quarter

Reef

Region

Regional Council

Republic

Special Administrative Region

Special City

Special district

Special Municipality

Special region

Special Region|Zone

State

Statistical Region

Territorial Authority

Territorial Unit

Territory

Town Council

Union Territory

Unitary Authority

Urban Prefecture

Voivodeship|Province

Water body

  1. > library(RODBC)
  2. > mdb <- odbcConnectAccess("gadm2.mdb",readOnlyOptimize=T)
  3. > a <- sqlQuery(mdb,"select DISTINCT ENGTYPE_1 from gadm2")
  4. > a[[1]]
  5.  [1] <NA>                                                      
  6.  [3]  Autonomous Republic          Administrative Area          
  7.   :

 gadm2 テーブルのOBJECTIDとShapeフィールドを読んで図形データのサイズや行数を調べます。

  1. > nrow <- sqlQuery(mdb,"select COUNT(*) from gadm2")
  2. > nrow <- as.numeric(nrow)
  3. > odbcQuery(mdb,"select OBJECTID,Shape from gadm2",rows_at_time =1)
  4. [1] 1
  5. > oid <- rep(NA,nrow)# 行のOBJECTID
  6. > ln <- rep(NA,nrow) # 各行の図形領域のサイズ
  7. > tp <- 0 # 緯度経度の総数
  8. > ts <- 0 # ポリゴンの総数
  9. > for(i in 1:nrow)
  10. + {
  11. +   a <- odbcFetchRows(mdb, max = 1, buffsize = 32000)
  12. +   oid[i] <- as.character(a[[1]][1])
  13. +   u <- unlist(a[[1]][2])
  14. +   ln[i] <- length(u)
  15. +   tp <- tp + readBin(u[41:44],"int")
  16. +   ts <- ts + readBin(u[37:40],"int")
  17. + }
  18. > ts # ポリゴンの総数
  19. [1] 315565
  20. > tp # 緯度経度の総数
  21. [1] 61316967
  22. > range(ln) # 図形データの最小最大
  23. [1]     112 9007976
  24. > oid[which.max(ln)] # 最長の図形データの行のOBJECTID
  25. [1] "34417"

 地表の [経度、緯度] が示されている箇所は 6,132万地点あり、32万のポリゴンで表されています。

 最も複雑な行政区画は OBJECTID=34417の行で、9MBの図形データで表されています。

 ほとんどの行の図形データが1MB以下で、4MBを超えるものは他にないようです。

  1. > odbcQuery(mdb,paste("select OBJECTID,NAME_0,NAME_1",
  2. +           "from gadm2 where OBJECTID=34417"),
  3. +           rows_at_time =1)
  4. [1] 1
  5. > a <- odbcFetchRows(mdb, max = 1, buffsize = 32000)
  6. > str(a)
  7. List of 2
  8.  $ data:List of 3
  9.   ..$ : int 34417
  10.   ..$ : chr "Chile"
  11.   ..$ : chr "Magallanes y Antartica Chilena"

  この場所はチリのマガジャネス・イ・デ・ラ・アンタルティカ・チレーナ州のようです。上部左はウェリントン島のようです。多数の島が詳細に描かれています。

  1. DrawPoly <- function(shape)
  2. {
  3.   u <- unlist(shape)
  4.   parts <- readBin(u[37:40],"int")
  5.   points <- readBin(u[41:44],"int")
  6.   # パートはdoube単位のオフセットだがポイント数として使用
  7.   pp <- rep(NA,parts)
  8.   p <- 45
  9.   for(i in 1:parts)
  10.   {
  11.     pp[i] <- readBin(u[p:(p+3)],"int")
  12.     p<- p + 4
  13.   }
  14.   if( parts > 1 )
  15.     pp[1:(parts-1)] <- pp[2:parts]-pp[1:(parts-1)]
  16.   pp[parts] <- points - pp[parts]
  17.   # パート(ポリゴン)を描画
  18.   for(k in 1:parts)
  19.   {
  20.     x <- rep(NA,pp[k])
  21.     y <- rep(NA,pp[k])
  22.     for(i in 1:pp[k])
  23.     {
  24.       x[i] <- readBin(u[p:(p+7)],"double")
  25.       y[i] <- readBin(u[(p+8):(p+15)],"double")
  26.       p <- p + 16
  27.     }
  28.     polygon(x,y)
  29.   }
  30. }
  31. #------------------------------------------------------
  32. # 最も複雑な行政区画を描画
  33. odbcQuery(mdb,"select Shape from gadm2 where OBJECTID=34417",
  34.           rows_at_time =1)
  35. a <- odbcFetchRows(mdb, max = 1, buffsize = 32000)
  36. par(mar=c(0,0,0,0))
  37. plot(0,0,col="white",xlim=c(-75.74514,-72.50806),
  38.      ylim=c(-52.75875,-48.59431))
  39. DrawPoly(a[[1]][1])

 日本の図形データは1813行分あります。各行には日本語で行政区画の名称が付けられています。

5. mapdataパッケージ

  R言語のパッケージは座標などから自動的データを取ってきて表示するような発想のようです。

  mapdataパッケージがどのようにデータを持っているのか分かりませんが簡便に地図を描いてくれます。

  河川については World Rivers Map Database と言うデータがあるようです。

  1. > nrow <- sqlQuery(mdb,paste("select COUNT(*) from gadm2",
  2. +                  "where NAME_0='japan'"))
  3. > nrow
  4.   Expr1000
  5. 1     1813
  6. > d <- sqlQuery(mdb,paste("select NAME_0,NL_NAME_1,NL_NAME_2",
  7. +                         "from gadm2",
  8. +                         "where NAME_0='japan'"))
  9. > str(d)
  10. 'data.frame':   1813 obs. of  3 variables:
  11.  $ NAME_0   : Factor w/ 1 level "Japan": 1 1 1 1 1 1 1 1 ...
  12.  $ NL_NAME_1: Factor w/ 47 levels "愛知県","愛媛県",..: 44 ...
  13.  $ NL_NAME_2: Factor w/ 1756 levels "あきる野市","あさぎり町",..

  日本は [経度、緯度] が 870,940 記録され、3,225ポリゴンで描かれるようです

  1. nrow <- sqlQuery(mdb,paste("select COUNT(*) from gadm2",
  2.                  "where NAME_0='japan'"))
  3. nrow <- nrow[[1]]
  4. odbcQuery(mdb,paste("select Shape from gadm2",
  5.                     "where NAME_0='japan'"),
  6.           rows_at_time =1)
  7. ln <- rep(NA,nrow) # 各行の図形領域のサイズ
  8. tp <- 0 # 緯度経度の総数
  9. ts <- 0 # ポリゴンの総数
  10. par(mar=c(0,0,0,0))
  11. plot(0,0,col="white",xlim=c(122.93320,153.98694),
  12.      ylim=c(24.04542,45.52279))
  13. for(k in 1:nrow)
  14. {
  15.   a <- odbcFetchRows(mdb, max = 1, buffsize = 32000)
  16.   DrawPoly(a[[1]][1])
  17.   u <- unlist(a[[1]][1])
  18.   ln[k] <- length(u)
  19.   tp <- tp + readBin(u[41:44],"int")
  20.   ts <- ts + readBin(u[37:40],"int")
  21. }
  22. ts # ポリゴンの総数
  23. tp # 緯度経度の総数
  24. range(ln) # 図形データの最小最大

  日本の範囲は [北緯24.04542°、東経122.93320°] と [北緯45.52279°,東経153.98694°] によって表される矩形領域の中にあるようです。

  愛知県をキーにして描くと左図下のようになります。

  1. par(mar=c(0,0,0,0))
  2. plot(0,0,col="white",xlim=c(136.708,137.7249),
  3.      ylim=c(34.6,35.42088))
  4. for(id in objid)
  5. {
  6.   odbcQuery(mdb,paste("select Shape from gadm2",
  7.                       "where OBJECTID=",id),
  8.             rows_at_time =1)
  9.   a <- odbcFetchRows(mdb, max = 1, buffsize = 32000)
  10.   DrawPoly(a[[1]][1])
  11. }
6. スペースシャトル地形データ

  Shuttle Radar Topography Mission (SRTM) はNASAが行ったスペースシャトルからの測定に基いた標高データのようです。

  N35E138.hgt.zip のように緯度と経度を名前に持った多数のファイルから出来ています。精度が1秒と3秒のデータがあるようです。無償で利用できるのは3秒のもののようです。SRTM1 や STRM3と区別されているようです。また、SRTM 90m と言う表記もあります。これは、緯度の3秒、赤道付近の経度の3秒が90m程度であることから来ているものと思います。

  1. > library(raster)
  2. > rs <- raster("N35E138.hgt/N35E138.hgt")
  3. > a <- readAll(rs)
  4. > plot(a)
  5. > range(a@data@values,na.rm=T)
  6. [1]  -16 3742
  7. > length(a@data@values)
  8. [1] 1442401
  9. > a@data@values[1:10]
  10.  [1] 963 947 911 869 813 782 757 751 736 742
  11. > fi<-file.info("N35E138.hgt/N35E138.hgt")
  12. > fi$size
  13. [1] 2884802
  14. > 1201*1201*2
  15. [1] 2884802

  N35E138.hgt.zip を解凍すると、N35E138.hgt になります。ファイルのサイズは2,884,802バイトです。これは、1201 x 1201 x 2 = 2,884,802 のようです。

  1° を3秒で割ると1200です。データは2バイトの整数です。

  R言語の raster パッケージは、このファイルを読み込んで図のような表示をします。

  N35E138は、N35-36、E138-139 のデータのようです。

  データの長さは 1,442,401 でファイル全体が標高データとして参照されます。ファイルの先頭を確認すると、Big Endian で読み込まれたデータと同じです。

  データの最大は3742です。これは富士山の標高に近く3742 m と解釈して良さそうです。

  また、データ中には 2417 の NA があります。どんな箇所が NA なのかは分かりません。ファイル上は16ビット整数なので NA は表現できませんが、0x8000 をNAとしているようです。16ビット整数の最小値の -32768 です。

  1. library(raster)
  2. rs <- raster("N35E138.hgt/N35E138.hgt")
  3. a <- readAll(rs)
  4. x <- rep(1:1201,1201) # x: 1:1201の数列を1201繰り返す
  5. # y: 1を1201個、2を1201個、・・・、1021を1201個
  6. y <- NULL; for(n in 1:1201) y <- c(y,rep(n,1201))
  7. # 標高データの NA と 負をゼロに
  8. z <- ifelse(is.na(a@data@values), 0, a@data@values)
  9. z <- ifelse(z < 0, 0, z)
  10. # 標高データを 1:10 に
  11. z <- floor(z / max(z)*9) + 1
  12. z <- rainbow(10)[z] # 標高を色に
  13. par(mar=c(3,3,2,1),mgp=c(1.5,0.5,0))
  14. plot(x,y,col=z) # 描画

  1列に並んだ数字列の順番の解釈を確認します。XY平面に、(0,0) から (0,1201)、(1,0) から (1,1201)、・・・、(1201,0) から (1201,1201)と描画して見ます。重い処理ですが1度きりなので良しとします。

  結果は plot(a) でパッケージが描くものと異なっています。差異は単にY方向が逆なだけのようです。

  したがって、N35E138.hgt ファイルのデータは、最も北から、「西から東へ」を繰り返して格納されているようです。表示のイメージそのままと理解出来ます。

  北緯の最大は60°までのようです。N60E163.hgt を見るとデータの最初の方はNAが詰められています。実際に有効なのは60.3°台までのようです。データ数は緯度に関係なく一定のようです。

  1°の表す東西の長さは緯度で大きく変わります。赤道では111km、60°では56km 程度です。緯度の絶対値が大きくなるほど水平方向のデータの密度は高いことになります。

  標高や海抜には、1)最寄の港湾の平均海水面、2)各国の定めるジオイド、3)世界規模のジオイド、4)衛星軌道に基いた楕円体高、と言った異なる基準があることになります。

  このデータはEGM96ジオイド面からの高さに加工したもののようです。

  富士山の標高は 3,776 m とされています。データ中の最大値は 3,742 m でした。34m 足りませんがピークが測定されなくても不思議はありません。また、この位置のジオイド高は 40m ほどで、小さすぎるので楕円体高ではないと考えられます。

  富士山の標高は日本で定めたジオイド面から測られたものですが、EGM96との差は 1.18 m 程度のようです。EGM96の方が僅かに標高が高く計算されることになります。

7. 標高について

  国内で使用されている山の高さや標高は東京湾の平均海水面からの高さです。これは世界規模の基準ではないと考えられます。

  日本の標高もジオイド面からの高さである点では世界規模の規準と変わりありません。ジオイドのゼロを東京湾の平均海水面としている点で異なっています。

  現在使用されてている高さは、楕円体高と標高の2種類のようです。衛星を使用して測定される楕円体高は 数mm 程度の精度があるようです。一方、標高はジオイド面からの高さで自明ではありません。

  日本ではジオイド面の規定を「日本のジオイド」や「日本のジオイド2000」と言うようです。これは「JGEOID2000」との差として与えられているようです。「JGEOID2000」は世界規模のジオイド高データである「EGM96」を日本部分について詳細化にしたもののようです。「JGEOID2000」は「ジオイド高」のデータで、「日本のジオイド2000」は「東京湾の平均海水面規準への修正量」のデータのようです。この修正量の最小値は -0.384 m、最大値は0. 358 m のようです。、「日本のジオイド2000」は、楕円体高の測定値から水準点の標高を引いて算出されたもののようです。「GSIGEO2011+2000」と言うジオイド高のデータが2kmメッシュで提供されているようです。

  国土地理院のつくば市の「地球ひろば」には展示用の三角点(標高28.0m)があり、正確な緯度、経度が示されているということです。

緯度

経度

GSIGEO2011+2000

EGM96

差(m)

一等三角点

36°06'03"N

140°05'23"E

40.092

38.9083

1.1837

二等三角点

36°06'04"N

140°05'21"E

40.095

38.9113

1.1837

 EGM96 の計算値より 1m18cm ほど大きく、前述の40cm弱の差ではないようです。この地点の楕円体高は 66.91m から 68.10m  ほどと言うことになります。

  前述のSRTMデータの N36E140.hgt の、この場所の高さは 25 m です。位置は完全に一致するものではないので、周囲の平均を取ると 27.33 m です。EGM96の方が低い位置から測るので大きな値になると考えましたが実際には違うようです。

  気象庁の富士山頂の地震計の設置場所は標高が 3772 m と記されています。

緯度

経度

GSIGEO2011+2000

EGM96

差(m)

35°21'38"N

 138°43'38"E

42.500

41.2970

1.203

 前述のようにSRTMの北緯35°、東経123°のデータの最大値は 3742 でした。

 このことは、SRTM の標高は、楕円体高ではないことは間違いなさそうです。文書としては単位がメートルであり、「 WGS84/EGM96 geoid」を参照とあります。

8. World Rivers Map Database

  河川は地図に不可欠に思えます。R言語の mapdata パッケージには World Rivers Map Database と言う説明がありました。

  このパッケージの map() は、最初の引数がデータベース名になっていて、そのデータベースの全体、または部分を表示するもののようです。

  1. > library(mapdata)
  2. > d <- map("world")
  3. > str(d)
  4. List of 4
  5.  $ x    : num [1:15356] -130 -132 -132 -133 NA ...
  6.  $ y    : num [1:15356] 55.9 56.7 57 58.4 NA ...
  7.  $ range: num [1:4] -180 190.3 -85.4 83.6
  8.  $ names: chr [1:2284] "Canada" "South Africa" "Denmark" "Great Lakes:Superior, Huron, Michigan" ...
  9.  - attr(*, "class")= chr "map"
  10. > d <- map("rivers")
  11. > str(d)
  12. List of 4
  13.  $ x    : num [1:1357] -123 -122 -123 -125 -118 ...
  14.  $ y    : num [1:1357] 65.2 66.2 66.2 66.2 66.4 ...
  15.  $ range: num [1:4] -164.5 160.8 -36.9 72.9
  16.  $ names: chr [1:239] "1" "2" "3" "4" ...
  17.  - attr(*, "class")= chr "map"

  "world" と言うデータベースには2284の国や地域があり、"Canada"、"South Africa" と言った国名で表示範囲を選択できます。

  "rivers" と言うデータベースには 239 の河川の図形があり、番号で識別されているようです。全体を描くと以下のようになります。

  1. map("world",mar=c(0,0,0,0),mgp=c(0,0,0),
  2.     col="blue",interior=F)
  3. map("rivers",add=T,col="red")

  チグリス、ユーフラテス川流域を表示する場合は以下のようにします。

  1. map("world",col="blue",
  2.     region=c("Iraq","Iran","Syria",
  3.              "Kuwait","Saudi Arabia"))
  4. map("rivers",add=T,col="red")

  世界地図の全図と、それと重なる河川の大きな図があって、その一部分だけが見えているイメージのようです。

  国境などの線は interior=F で非表示になります。これは、データが独立しているのではなく、前述の union() に依るもののようです。

  河川データは値から [経度、緯度] のようです。

  データベースには他に、japan、china、nz、world2 があります。

  日本の全図は、worldのjapan とjapan の2通りあることになります。

  1. map("world","japan")
  2. map("japan")

  japan データベースは都道府県名で選択できます。

  1. map("japan","Aichi")

 riverse には日本の河川データはありません。

  国土地理院は河川データを公開しているので利用する方法はあるのだと思います。

  この世界全図は 15,356 ポイントとコンパクトです。このデータで地球儀を描いてみます。 rgl パッケージで地図を描けば平面へのプロジェクションの問題を回避できます。個人がパソコンで見る分には平面にする必要性は特にないと思います。

  rgl でプロットした図は自由に回転したり拡大縮小できます。

  このデータには 3902 ポイントの NA があります。世界地図は一筆書きできるものではないので複数の線データをNAで区切っているものと思います。したがって、クローズしている線は始点と終点が同じ値になっていることになります。この閉じた線はポリゴンで塗ることが出来ると思います。

  また、経度は東経を正、西経を負で表していますが東経には180°を超えるものがあります。189.8° ほどまであり、連続した線を描くために調整されているのだと思います。

  RGLのXYZ直交座標系で描くために [経度、緯度] を(x、y、z)に変換します。緯度は「地理緯度」だと解釈しました。準拠楕円体上の接線の法線と、赤道面のなす角です。地心座標に変換して、地心を通る直線と楕円体表面の交点の座標を計算します。

  1. # 度で与えられた経度と緯度(地理緯度)からXYZ座標を計算
  2. XYZ <- function(la,fa) #!!! 経度、緯度の順
  3. {
  4.   a <- 6378137      # WSG84準拠楕円体の赤道半径
  5.   b <- 6356752.3142 # f:298.257223563から極半径  
  6.   a2 <- a^2
  7.   b2 <- b^2
  8.   ph <- atan(b2/a2*tan(fa*pi/180)) # 地理緯度から地心緯度に
  9.   la <- la * pi / 180 # 経度を弧度に
  10.   # tan(ph)の傾きの直線と楕円の交点
  11.   ta <- tan(ph)
  12.   ta2 <- ta^2
  13.   u <- sqrt(b2 + a2*ta2)
  14.   xx <- a*b / u
  15.   c(xx*cos(la),xx*sin(la),a*b*ta / u)
  16. }

この関数を使って地球儀を描きます。

  1. library(rgl)
  2. library(mapdata)
  3. d <- map("world",plot=F)
  4. n <- length(d$x)
  5. xyz <- array(NA,c(n,3))
  6. for(i in 1:n)
  7. {
  8.   if( !is.na(d$x[i]) )
  9.   {
  10.     xyz[i,] <- XYZ(d$x[i], d$y[i])
  11.   }
  12. }
  13. plot3d(xyz[,1],xyz[,2],xyz[,3],t="l",col="blue",axes=F)
  14. # 赤道
  15. a <- 6378137
  16. t <- seq(0,2*pi,length.out=100)
  17. plot3d(a*cos(t),a*sin(t),0,t="l",col="red",add=T)

  マウス操作で回転して北海道の辺りを拡大すると図のように見えます。

  rgl には polygon3d() があって塗れるかもしれないと考えましたが簡単ではないようです。図形データには線が交差しているものが含まれています。

準拠楕円体を塗ることを考えます。

  1. library(cda)
  2. a <- 6378137
  3. b <- 6356752.3142
  4. open3d()
  5. shapelist3d(rgl.ellipsoid(a=a,b=a,c=b),
  6.             col="yellow")
  7. plot3d(xyz[,1],xyz[,2],xyz[,3],t="l",
  8.        col="blue",axes=F,add=T)
  9. # 赤道
  10. t <- seq(0,2*pi,length.out=100)
  11. plot3d(a*cos(t),a*sin(t),0,t="l",
  12.        col="red",add=T)

  楕円体の図形を生成する関数は cdaパッケージにありました

  上のスクリプトの後半の描画部分を以下に差し替えると左図になります。

9. 山脈

  山脈も河川と共に歴史の話に良く登場します。ヒマラヤは、ほぼ完全に人の往来を妨げていたのだと思います。また、コーカサスやアルプス、ピレネーは軍事行動を制限していました。前8世紀にはウクライナのキンメリア人を追ったスキタイがコーカサスの東端を通ってメソポタミア(メディア)へ侵入したと考えられているようです。BC216、ハンニバルは象を伴ってアルプスを越えローマに迫りました。

  人口の大半が標高の低いところにあることは確かそうです。平らな広い場所は、低地なら平野、標高が高いところは高原と呼ばれるようです。 デカン高原の標高は 300-600m のようです。

  おそらく、数百メートルを越える標高の場所は人の移動に障害となるのだと思います。

  最も標高の高い都市はボリビアの都市で、エル・アルト、ポトシが上げられています。エル・アルトは標高4,150mで人口は83万人程度のようです。

  SRTM30 のデータは、南緯60° から北緯90° で、経度は360°分揃っているようです。1つのファイルは、緯度50°、経度40°分です。3 x 9 = 27 ファイルから成ります。ファイル名は、「西端北端.dem」となっています。e020n40.dem は、東経20°から東経60°、南緯10°から北緯40°の区域の標高です。w020n40.dem は、西経20°(-20°)から東経20°の範囲になります。

  ドキュメントでは、このデータの最小値は -415 m、最大値は 8685 m です。

  データの格納位置から計算した最小値の [経度、緯度 ] は、[35.50833、31.31156] です。死海(東経35度30分0秒、北緯31度30分0秒)のようです。

  最大値の [経度、緯度 ] は、[86.84167、27.975] です。エベレスト(東経86度56分40秒、北緯27度59分16秒)の近傍と言うことです。

  人の移動を妨げてきた山脈を地図に加えたいと思います。地球規模で考えて、2,000 m 以上を描いてみようと思います。

 R言語の contour() で、SRTM30の e060n40 を描くと左図のようになります。

  期待したのは2000m以上の地帯を囲むポリゴンですが細かな図形の集まりになってしまいます。

  データ値が2000m以上を赤、0m以下を青に塗ると下図のようになります。欲しいのは赤の部分の輪郭のポリゴンです。それが得られれば、polygon3d()を使って、地球儀の上に山脈が描けそうです。

  しかし試行錯誤して見て単純な話しではないことを知りました。

  まず、等高線に相当する図形データを得ることが必要です。contour() は図形データを返さないようなので、等高線に相当する図形を描くR言語のスクリプトを作ってみました。一般に等高線は、指定の高さの (x,y) を計算します。これに対して今回は格子状の (x,y)  のどこを通るかと言う考え方で作ります。 (x,y)  は [経度、緯度] で、精度面でも差分を取って(x,y) を調整する必要性はないと考えました。

  1. # 探索方向による確認順
  2. D <- matrix(c(
  3.   -1,-1, -1, 0, -1, 1,  0, 1,  1, 1,  1, 0,  1,-1,  0,-1,
  4.   -1, 0, -1, 1,  0, 1,  1, 1,  1, 0,  1,-1,  0,-1, -1,-1,
  5.   -1, 1,  0, 1,  1, 1,  1, 0,  1,-1,  0,-1, -1,-1, -1, 0,
  6.    0, 1,  1, 1,  1, 0,  1,-1,  0,-1, -1,-1, -1, 0, -1, 1,
  7.    1, 1,  1, 0,  1,-1,  0,-1, -1,-1, -1, 0, -1, 1,  0, 1,
  8.    1, 0,  1,-1,  0,-1, -1,-1, -1, 0, -1, 1,  0, 1,  1, 1,
  9.    1,-1,  0,-1, -1,-1, -1, 0, -1, 1,  0, 1,  1, 1,  1, 0,
  10.    0,-1, -1,-1, -1, 0, -1, 1,  0, 1,  1, 1,  1, 0,  1,-1),
  11.    ncol=16, nrow=8, byrow=T)
  12. # 検出ポイントによる探索方向
  13. E <- matrix(c(6,5,4,
  14.               7,0,3,
  15.               8,1,2), ncol=3, byrow=T)
  16. # 接続ポイントの探索
  17. FindNext <- function(cs, rs, c, r, dr)
  18. {
  19.   for(i in seq(1,by=2,length.out=8))
  20.   {
  21.     tc <- c + D[dr,i]; tr <- r + D[dr,i+1]
  22.     nr <- which(rs==tr)
  23.     if(length(nr)>0)
  24.     {
  25.       nc <- which(cs[nr]==tc)
  26.       if(length(nc)>0)
  27.       {
  28.         return(c(E[D[dr,i]+2,2-D[dr,i+1]],nr[nc]))
  29.       }
  30.     }
  31.   }
  32.   return(NULL)
  33. }
  34. #-------------------------------------------------
  35. # 等高線(境界のポイントを結ぶ)
  36. SimpleContour <- function(m,level)
  37. {
  38.   ncol <- dim(m)[1]
  39.   nrow <- dim(m)[2]
  40.   # 変化点の抽出
  41.   m[which(m<level)] <- 0
  42.   m[which(m!=0)] <- 1
  43.   # 行、列の両方で境界を検出するほうが良いが容量不足になる
  44.   m[,1:(nrow-1)] <- xor(m[,1:(nrow-1)],m[,2:nrow])
  45.   #m2 <- m
  46.   #m2[,1:(nrow-1)] <- xor(m[,1:(nrow-1)],m[,2:nrow])
  47.   #m[1:(ncol-1),] <- m2[1:(ncol-1),]
  48.   #   + xor(m[1:(ncol-1),],m[2:ncol,])
  49.   ps <- which(m>=1,arr.ind=T)
  50.   rm(m)
  51.   cs <- ps[,1]
  52.   rs <- ps[,2]
  53.   #
  54.   plot(0,0,col="white",xlim=c(0,ncol),ylim=c(0,nrow))
  55.   #plot(cs,rs,col="green",xlim=c(0,ncol),ylim=c(0,nrow))
  56.   #
  57.   x <- rep(NA,ncol*6)
  58.   y <- rep(NA,ncol*6)
  59.   dr <- 1 # 1下,2,3,4,5,6,7,8(反時計周り)
  60.   while(length(cs)>1)
  61.   {
  62.     c <- cs[1]; r <- rs[1]
  63.     cs[1] <- 0; rs[1] <- 0
  64.     x[1] <- c; y[1] <- r
  65.     p <- 1
  66.     dr <- 1
  67.     repeat
  68.     {
  69.       n <- FindNext(cs, rs, c, r, dr)
  70.       if( length(n) == 0 ) break
  71.       dr <- n[1]
  72.       c <- cs[n[2]]; r <- rs[n[2]]
  73.       cs[n[2]] <- 0; rs[n[2]] <- 0
  74.       p <- p + 1
  75.       x[p] <- c; y[p] <- r
  76.     }
  77.     if(p>2)
  78.     {
  79.       k1 <- abs(x[p]-x[1]); k2 <- abs(y[p]-y[1])
  80.       if( (k1<2) && (k2<2) )
  81.       {
  82.         polygon(x[1:p],y[1:p])
  83.       } else {
  84.         lines(x[1:p],y[1:p])
  85.       }
  86.     }
  87.     n <- which(cs>0)
  88.     cs <- cs[n]
  89.     rs <- rs[n]
  90.   }
  91. }
  92. #-------------------------------------------------
  93. ncol <-4800
  94. nrow <- 6000
  95. fn <- "srtm30/E060N40.DEM"
  96. f <- file(fn, "rb")
  97. m <- array(NA,c(ncol,nrow))
  98. for(i in 1:nrow)
  99. {
  100.   a <- readBin(f,integer(),ncol,size=2,endian="big")
  101.   m[,nrow-i+1] <- a
  102. }
  103. close(f)
  104. rm(a)
  105. windows(3,3)
  106. par(mar=c(3,3,2,1),mgp=c(1.5,0.5,0))
  107. SimpleContour(m,2000)
  108. title("素朴なスクリプトで描画(SRTM30区画)",cex.main=0.8)

  境界自体は排他的論理和や、水準を引いた後の2点の値の積の符号で検出できます。容量不足なので境界の座標データだけを残して元データは解放することにしました。輪郭抽出アルゴリズムのように逐次周辺の8個の高さを見ないで済む範囲で接続しました。

  21 x 21 極小さな部分を見ると、contour() は綺麗に線を引きます。このスクリプトでは細切れになってしまいます。

  しかし、全体を描けば大差はないようです。

  細切れになったものを上手く繋ごうと試行錯誤していてやっと気が付いたのは図形を連結して行くと輪郭抽出アルゴリズムと同じようにホールのできる可能性が生じることです。ホールのある図形を1つの図形として扱う方法が無いので連結しても意味がありません。

  細かいポリゴンをたくさん描くことは必須のようです。

  残る問題は、標高の高い山脈の中心部分のポリゴンが生成されていないことです。

  そこで、東西方向に標高の高いところの連続区間を取るようなアルゴリズムに変えました。

  しかし、残念ながら polygon3d() で塗る目論見は上手く行きませんでした。

  下図は polygon3d() ですが、fill=FALSE として描画したものです。塗ろうとするとエラーが発生します。

まず、NAで区切って複数図形を一度に渡すことが出来ないようです。また、先頭と最後のポイントを一致させる必要はなく、逆にエラーになります。

  これらを修正しても十数個に1つの割合でエラーになるポリゴンがあります。

  エラーになる最初のポリゴンは線分上に点が乗ってしまうケースでした。

  各点について、その点を端に持たない全ての線分に付いて、領域が重なり、線分の一端と結んだ線の傾きが同じものを探します。あれば、凹凸をなまらせる方向に1つ点を移動して調整しました。この操作は1つの直線上に3つ以上点があると複雑になるので図形の単純化と繰り返しで変化が無くなるまで繰り返しました。

  それでも数十個に1つ程度でエラーになります。ポリゴンの形状に異常はありません。良く分かりませんが細長い狭い箇所のある図形がエラーになるようです。エラーは三角形に分割することに失敗すると言うことのようです。 polygon3d() は x、y、z を対等に扱っているのではなく、x、y だけで三角形に分割しているようです。したがって、XY平面に垂直な図形はエラーになりますが、ここでは該当しません。

  もう一つの問題はポリゴンを単純化したこともあって、アルゴリズムから東西に長い線分を生じることです。直線は地表にもぐってしまうのでヒマラヤ山脈の中心部分が見えなくなってしまいました。改めて線分の長さが 1° を越えたら分割して描きました。

  ここまで試して、3Dについてもう少し知る必要がありそうだと考えました。「rgl パッケージ

10. 3D Quadrangle Mesh

  rgl パッケージの使い方を「rgl パッケージ」のように試して見ました。

  qmesh3d(バーテックス、インデックス) として四角形メッシュ図形が作れます。

  SRTM30のデータは、東西に40°、南北に50°を1ファイルとして作られています。このファイルの単位でバーテックスとインデクスを抽出し qmesh3d を作って連結しました。

   2000mを越える地帯は少なく、ヒマラヤ山脈は例外のようです。中国との交通は大きく迂回する以外には不可能だったと考えて良さそうです。1万1千年前ころに間氷期に入りますが、ヒマラヤの周辺は長い間、氷河による水の豊かな場所だったのだろうと推測できます。

  ウクライナにいたスキタイがメディアに侵入したのはコーカサス山脈を迂回するのにカスピ海沿岸を通ったことが理由のようです。

  セレウコスはチャンドラグプタに東部地域を割譲しました。アショーカ王のギリシア文字・アラム文字碑文はカンダハールにあると言うことです。カンダハールは標高千メートル強のようです。

  古代の都市を [経度、緯度] でプロットすれば河川や山脈との位置関係がはっきりします。

  1. # 度で与えられた経度と緯度(地理緯度)からXYZ座標を計算
  2. XYZ <- function(la,fa) #!!! 経度、緯度の順
  3. {
  4.   if(is.na(la)||is.na(fa))
  5.     return(c(NA,NA,NA))
  6.   a <- 6378137      # WSG84準拠楕円体の赤道半径
  7.   b <- 6356752.3142 # f:298.257223563から極半径  
  8.   a2 <- a^2
  9.   b2 <- b^2
  10.   ph <- atan(b2/a2*tan(fa*pi/180)) # 地理緯度から地心緯度に
  11.   la <- la * pi / 180 # 経度を弧度に
  12.   # tan(ph)の傾きの直線と楕円の交点
  13.   ta <- tan(ph)
  14.   ta2 <- ta^2
  15.   u <- sqrt(b2 + a2*ta2)
  16.   xx <- a*b / u
  17.   c(xx*cos(la),xx*sin(la),a*b*ta / u)
  18. }
  19. #------------------------------------------------------
  20. # 色を塗った地球楕円体を描く
  21. library(rgl)
  22. library(cda)
  23. a <- 6378137
  24. b <- 6356752.3142
  25. plot3d(rgl.ellipsoid(a=a,b=a,c=b),xlab="",ylab="",zlab="",
  26.        axes=F, col="khaki")
  27. clear3d(type="lights"); light3d(specular="black")
  28. # mapdataパッケージのworld,riversを3Dで表示
  29. library(mapdata)
  30. d <- map("world",plot=F)# 行政区画
  31. d <- mapply(XYZ,d$x,d$y)# XYZ座標系に変換
  32. plot3d(d[1,],d[2,],d[3,],
  33.        t="l",col="gray40",add=T)
  34. d <- map("rivers",plot=F)# 河川
  35. d <- mapply(XYZ,d$x,d$y) # XYZ座標系に変換
  36. plot3d(d[1,],d[2,],d[3,],
  37.        t="l",col="blue",add=T)
  38. #------------------------------------------------------
  39. # 赤道
  40. t <- seq(0,2*pi,length.out=100)
  41. plot3d(a*cos(t),a*sin(t),0,t="l",col="red",add=T)
  42. # 緯線 -60,-10,40,
  43. t <- seq(0,360,length.out=100)
  44. for(fa in c(-60,-10,40))
  45. {
  46.   d <- mapply(XYZ,t,fa)
  47.   lines3d(d[1,],d[2,],d[3,],col="gray60")
  48. }
  49. # 経線
  50. las <- c(-140,-100,-60,-20,20,60,100,140,180)
  51. t <- seq(-90,90,length.out=50)
  52. for(la in las)
  53. {
  54.   d <- mapply(XYZ,la,t)
  55.   lines3d(d[1,],d[2,],d[3,],col="gray60")
  56. }
  57. #------------------------------------------------------
  58. # 標高 2000m 以上を描画
  59. load("srtm30/world2k.R.data")
  60. shade3d(world2k,color="#808000")
  61. #------------------------------------------------------
  62. # 都市名を入れる例
  63. Num <- function(c)
  64. {
  65.   c( c[1]+c[2]/60+c[3]/3600, c[4]+c[5]/60+c[6]/3600 )
  66. }
  67. cities <- list(
  68.   list(Num(c(33,5,37, 44,34,50)),"Ctesiphon","クテシフォン",c(0,0.6)),
  69.   list(Num(c(33,5,40, 44,31,20)),"Seleucia","セレウキア",c(1.1,0.5)),
  70.   list(Num(c(36,21,34, 43,09,10)),"Nineveh","ニネヴェ",c(1,0.5)),
  71.   list(Num(c(32,32,11, 44,25,15)),"Babylon","バビロン",c(1,1)),
  72.   list(Num(c(33,20,00, 44,26,00)),"Baghdad","バグダート",c(0.1,-0.1)),
  73.   list(Num(c(30,57,45, 46,06,11)),"Ur","ウル",c(1,1.5)),
  74.   list(Num(c(31,19,20, 45,38,10)),"Uruk","ウルク",c(1,1)),
  75.   list(Num(c(35,27,24, 43,15,45)),"Assur","アッシュール",c(1,0.5)),
  76.   list(Num(c(32,11,26, 48,15,28)),"Susa","スサ",c(0.5,0.5)),
  77.   list(Num(c(29,56,04, 52,53,29)),"Persepolis","ペルセポリス",c(0,0.5)),
  78.   list(Num(c(30,00,42, 52,24,28)),"Anshan","アンシャン",c(1,0.5)),
  79.   list(c(33.7560,72.8291),        "Gandhara","ガンダーラ",c(0,0.5)),
  80.   list(Num(c(36,46,23, 66,52,25)),"Bactra","バクトラ",c(0,0.5)),
  81.   list(Num(c(31,37,01, 65,43,01)),"Kandahar","カンダハール",c(0,0.5)),
  82.   list(c(25.611, 85.144),"Pataliputra","パータリプトラ",c(0,0.5)),
  83.   list(c(31.198, 29.9192),"Alexandria","アレクサンドリア",c(1,0.5)),
  84.   list(c(40.76, 22.519167),"Pella","ペラ",c(1,0.5)) )
  85. for(i in 1:length(cities))
  86. {
  87.   xyz <- XYZ(cities[[i]][[1]][2],cities[[i]][[1]][1])
  88.   points3d(xyz[1],xyz[2],xyz[3],color="red")
  89.   text3d(xyz[1],xyz[2],xyz[3]*1.03,cities[[i]][[2]],
  90.          color="black",adj=cities[[i]][[4]],cex=0.8,
  91.          font=2)
  92. }

  デフォルトでは大きなスペキュラが描かれ中心部分の表示が飛んでしまいます。ライトの設定は一度クリアすると上手く行くので、何かまだ知らない設定があるようです。

  テキストも表示位置によって地面にもぐりこむので工夫が必要です。

  2000m以上の箇所の着色は、world2k.R.data をロードして行っています。load() は退避した変数を復元するもので、world2k を復元します。world2k.R.data に save() した変数は、以下の手順で作りました。

  C#でプログラムを書いて、SRTM30 のファイルから、ファイルごとに座標とインデクスのファイルを作りました。

  1. class ColRow
  2. {
  3.     public int col; // ラスターデータのカラム、あるいは経度
  4.     public int row; // ラスターデータの行、あるいは緯度
  5.     public ColRow(int col, int row)
  6.     {
  7.         this.col = col; this.row = row;
  8.     }
  9. }
  10. const int MESHMAX = 120; // 1度
  11. const int MESHMIN = 12;  // 6分
  12. const int MESHLIM = MESHMIN * MESHMIN / 2;
  13. int[,] z;// MESHMIN x MESHMIN のlevel以上のカウント
  14. // 経度は0から4799で、40度の範囲
  15. // 緯度は0から5999で、50度の範囲
  16. List<ColRow> lafa = new List<ColRow>();
  17. List<int> indices = new List<int>();
  18. string fileName;
  19. public SRTM30QMesh(string fileName, int ncol, int nrow, int level)
  20. {
  21.     this.fileName = fileName;
  22.     BinaryReader br = new BinaryReader(
  23.         File.OpenRead(fileName));
  24.     z = new int[ncol / MESHMIN, nrow / MESHMIN];
  25.     for (int r = 0; r < z.GetLength(1); r++)
  26.     {
  27.         for (int i = 0; i < MESHMIN; i++)
  28.         {
  29.             // 1行読み込み
  30.             byte[] by = br.ReadBytes(ncol * 2);
  31.             // 1行のカウント
  32.             int p = 0;
  33.             for (int c = 0; c < z.GetLength(0); c++)
  34.             {
  35.                 // 1行のMESHMIN個のカウント
  36.                 for (int k = 0; k < MESHMIN; k++)
  37.                 {
  38.                     int v = (sbyte)by[p++];
  39.                     v = v * 256 + by[p++];
  40.                     if (v >= level) z[c, r]++;
  41.                 }
  42.             }
  43.         }
  44.     }
  45.     br.Close();
  46.     // z[,]の処理
  47.     ColRow cr;
  48.     while ((cr = Find()) != null)
  49.     {
  50.         CreateMesh(cr);
  51.     }
  52.     // 結果をファイルへ出力
  53.     Write();
  54. }
  55. // 座標とインデクスをそれぞれファイルに出力
  56. public void Write()
  57. {
  58.     string fn = System.IO.Path.GetFileNameWithoutExtension(fileName);
  59.     TextWriter tw = File.CreateText(@"C:\CodeSamples\R_WORK\"+fn+"_coord.dat");
  60.     foreach (var d in lafa)
  61.     {
  62.         tw.WriteLine(d.col + " " + d.row);
  63.     }
  64.     tw.Close();
  65.     tw = File.CreateText(@"C:\CodeSamples\R_WORK\"+fn+"_index.dat");
  66.     for (int i = 0; i < indices.Count; i += 4)
  67.     {
  68.         tw.WriteLine(indices[i] + " " + indices[i + 1] + " " + indices[i + 2] + " " + indices[i + 3]);
  69.     }
  70.     tw.Close();
  71. }
  72. // z[,]全体から出力対象を探し、見つかったら処理済にセットする
  73. ColRow Find()
  74. {
  75.     for (int i = 0; i < z.GetLongLength(1); i++)
  76.         for (int k = 0; k < z.GetLongLength(0); k++)
  77.             if (z[k, i] > MESHLIM)
  78.             {
  79.                 z[k, i] = -1;
  80.                 return new ColRow(k, i);
  81.             }
  82.     return null;
  83. }
  84. // 矩形を検出して登録
  85. void CreateMesh(ColRow cr)
  86. {
  87.     int w = 1;
  88.     int c = cr.col + 1;
  89.     while ((w < MESHMIN) && (c < z.GetLength(0)))
  90.     {
  91.         if (z[c, cr.row] <= MESHLIM) break;
  92.         w++;
  93.         z[c, cr.row] = -1;
  94.         c++;
  95.     }
  96.     int h = 1;
  97.     int r = cr.row + 1;
  98.     while ((h < MESHMIN) && (r < z.GetLength(1)))
  99.     {
  100.         bool high = true;
  101.         for (int k = 0; k < w; k++)
  102.         {
  103.             if (z[cr.col + k, r] <= MESHLIM)
  104.             {
  105.                 high = false;
  106.                 break;
  107.             }
  108.         }
  109.         if (!high) break;
  110.         h++;
  111.         for (int k = 0; k < w; k++)
  112.             z[cr.col + k, r] = -1;
  113.         r++;
  114.     }
  115.     int la1 = cr.col * MESHMIN;
  116.     int la2 = la1 + w * MESHMIN;
  117.     int fa1 = cr.row * MESHMIN;
  118.     int fa2 = fa1 + h * MESHMIN;
  119.     SetQMesh(la1, fa1, la2, fa2);
  120. }
  121. //---------------------------------------------------
  122. // lafaリストの要素間の比較用関数
  123. ColRow cur_lafa;
  124. bool compareLaFa(ColRow lafa)
  125. {
  126.     if (lafa.col != cur_lafa.col) return false;
  127.     if (lafa.row != cur_lafa.row) return false;
  128.     return true;
  129. }
  130. //---------------------------------------------------
  131. // 四角形を登録
  132. void SetQMesh(int x1, int y1, int x2, int y2)
  133. {
  134.     int i;
  135.     Action<int, int> Add = (Action<int, int>)((x, y) =>
  136.     {
  137.         cur_lafa = new ColRow(x, y);
  138.         i = lafa.FindIndex(compareLaFa);
  139.         if (i < 0)
  140.         {
  141.             i = lafa.Count; // 新出のポイント
  142.             lafa.Add(cur_lafa);
  143.         }
  144.         indices.Add(i);
  145.     });
  146.     Add(x1, y1);
  147.     Add(x2, y1);
  148.     Add(x2, y2);
  149.     Add(x1, y2);
  150. }

  このファイルを読み込んで world2k に連結します。

  1. # メッシュデータの連結してworld2k.R.dataを作る
  2. MeshCat <- function(mesh1,mesh2)
  3. {
  4.   mesh <- mesh1
  5.   mesh$vb <- cbind(mesh1$vb,mesh2$vb)
  6.   mesh$ib <- cbind(mesh1$ib,mesh2$ib + dim(mesh1$vb)[2])
  7.   mesh
  8. }
  9. # SRTM30の区画ごとのデータをメッシュデータに
  10. SRTM30Mesh <- function(fn)
  11. {
  12.   bLa <- as.integer(substr(fn,2,4))
  13.   bFa <- as.integer(substr(fn,6,7))
  14.   if(toupper(substr(fn,1,1))=="W") bLa <- -bLa
  15.   if(toupper(substr(fn,5,5))=="S") bFa <- -bFa
  16.   lafa <- scan(paste(fn,"_coord.dat",sep=""))
  17.   indx <- scan(paste(fn,"_index.dat",sep=""))
  18.   if(length(lafa)==0)
  19.     return(NULL)
  20.   m <-matrix(1,ncol=length(lafa)/2,nrow=4)
  21.   p <- 1
  22.   for(i in 1:(length(lafa)/2))
  23.   {
  24.     xyz <- XYZ(bLa+lafa[p]/120.0,bFa-lafa[p+1]/120.0)
  25.     m[1,i] <- xyz[1]; m[2,i] <- xyz[2]; m[3,i] <- xyz[3]
  26.     p <- p + 2
  27.   }
  28.   i <- matrix(indx+1,nrow=4)
  29.   qmesh3d(m,i)
  30. }
  31. # メッシュデータファイルの名前
  32. fns <- c(
  33. "E020S10","E060S10","E100S10","E140S10","W020S10","W060S10","W100S10","W140S10","W180S10",
  34. "E020N40","E060N40","E100N40","E140N40","W020N40","W060N40","W100N40","W140N40","W180N40",
  35. "E020N90","E060N90","E100N90","E140N90","W020N90","W060N90","W100N90","W140N90","W180N90")
  36. # 連結操作
  37. mesh1 <- SRTM30Mesh(fns[1])
  38. mesh2 <- SRTM30Mesh(fns[2])
  39. world2k <- MeshCat(mesh1,mesh2)
  40. for(fn in fns[3:length(fns)])
  41. {
  42.   mesh <- SRTM30Mesh(fn)
  43.   if(is.null(mesh)) {
  44.     cat(fn,"\n")
  45.   } else {
  46.     world2k <- MeshCat(world2k,mesh)
  47.   }
  48. }
  49. # 描画
  50. shade3d(world2k,color="#808000")
  51. # 保存
  52. save(world2k,file="world2k.R.data")
  53. str(world2k)

  save(world2k,file="world2k.R.data") で保存しました。このファイルは4バイト整数に件数を掛けて計算した容量より僅かに小さいようです。

  ここで作成したデータは荒いもので、1° か 6分の四角形メッシュで描かれています。

  マウスホイールでズームすると矩形が目立ちます。その一辺はおよそ 10 km 程度と言うことになります。緯度が極に近づくと東西の1°の距離は短くなります。矩形は東西に狭くなっていきます。

   ヒマラヤに次いで2000m 以上の広い場所はグリーンランドのようです。グリーンランドの氷河の厚さは3000m以上の箇所もあると言うことです。SRTM30の高さには氷層の厚さも加わっていると言うことのようです。


題目一覧へmikeo_410@hotmail.com(updated: 2022/09/08)