研一的時候閑著無聊就一直想做3D模型,由于自己本身是做地學的,想畫一個地球儀也是理所當然,于是就有了stackoverflow上各種問道,問題被close,表述不清,經歷很多風雨只有,在一位外國有人的熱心提示下做出了自己想要的東西,時隔兩年,今天把當年的努力過程整理一下,算是獻給簡書的第一篇文章。
(*elev data input*)
elev1d = BinaryReadList[ "D:\\topo\\ETOPO5.DAT", {"Integer16"}, ByteOrdering -> +1];
elev2d = ArrayReshape[elev1d, {2160, 4320}];
lati = Flatten@Transpose@Table[Rest@Table[i, {i, 90, -90, -1/12}], {4320}];
long = Flatten@Table[Rest@Table[i, {i, 0, 360, 1/12}], {2160}];
(*make a {lat,lon,altitude} matrix*)
elevlatlon = Transpose@{lati, long, Flatten@elev1d};
(*select part of the huge amount of data,add mean earth radius to altitude*)
elevlatlonInUse = (elevlatlon[[;; ;; 12, All]] /. {m_, n_, o_} -> {m, n, o/200 + 6721}) /. {x_, y /; y > 180, z_} -> {x, y - 360, z};
coordsToXYZ[list_] := Transpose[{Cos[#[[1]]*Pi/180.]*Cos[#[[2]]*Pi/180.]*#[[3]], Cos[#[[1]]*Pi/180.]*Sin[#[[2]]*Pi/180.]*#[[3]], Sin[#[[1]]*Pi/180.]*#[[3]]} &@Transpose[list]]
xyz = First[coordsToXYZ /@ {elevlatlonInUse}];
ListPointPlot3D[xyz, BoxRatios -> {1, 1, 1}]
ListSurfacePlot3D[xyz, BoxRatios -> {1, 1, 1}]
結果顯示并不是我想要的,因為mma無法差值到一個3D的球面,最后可能出于方差最小之類的考慮,給我了這樣一個亂七八糟的平面:亂七八糟的平面
事實上,畫出點的分布,發現也是沒錯的:
點的分布
所以,ListSurfacePlot3D被證明不適合畫這樣大數據量的差值表面,只能用球坐標函數搞定了:
elev1d = BinaryReadList["D:\\topo\\ETOPO5.DAT", {"Integer16"}, ByteOrdering -> +1];
elev2d = ArrayReshape[elev1d, {2160, 4320}]/5 + 6731;
elevplot2d = ListContourPlot[elev2d[[2160 ;; 1 ;; -6, 1 ;; 4320 ;; 6]], ContourStyle -> None, ColorFunction -> "Topographic", Frame -> None, AspectRatio -> 0.5, ImageSize -> Full, PlotRangePadding -> None];
sealevel3d = ParametricPlot3D[ {6731*Cos[lon]*Sin[lat], 6731*Sin[lon]*Sin[lat], 6731*Cos[lat]}, {lon, 0, 2 Pi}, {lat, -Pi, 0}, Lighting -> "Neutral", RotationAction -> "Clip", Mesh -> None, Axes -> False, Boxed -> False, PlotStyle -> Directive[Opacity[0.5], Blue] ];
terr3d = ParametricPlot3D[ {elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Cos[lon]* Sin[lat], elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Sin[lon]* Sin[lat], elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Cos[lat]}, {lon, 0, 2 Pi}, {lat, -Pi, 0}, TextureCoordinateFunction -> ({1-#4, 1 - #5} &), PlotStyle -> Texture[Show[elevplot2d, ImageSize -> 1000]], Lighting -> "Neutral", RotationAction -> "Clip", Mesh -> None, Axes -> False, PlotPoints -> 35, Boxed -> False ];
Show[sealevel3d, terr3d]
成品是這樣的(配色依然有點丑,別介意諸位):當然,不畫球狀的3D地形還是很簡單的:
elev1d = BinaryReadList["D:\\project\\mma\\topo\\ETOPO5.DAT", {"Integer16"},ByteOrdering -> +1];
lati = Flatten@Transpose@Table[Rest@Table[i, {i, 90, -90, -1/12}], {4320}];
long = Flatten@Table[Rest@Table[i, {i, 0, 360, 1/12}], {2160}];
elevlatlon = Transpose@{long, lati, Flatten@elev1d} /. {x_ /; x > 180, y_, z_} -> {x - 360, y, z};
elevplot3d =
ListPlot3D[
Cases[elevlatlon[[;; ;; 6, All]], {x_ /; x > 70 && x < 105,
y_ /; y > 25 && y < 45, _}], Mesh -> None,
ColorFunction -> "Topographic", MeshFunctions -> {#3 &},
BoxRatios -> {2, 1, 0.1}, ImageSize -> Full]
QQ圖片20161101104343.jpg
最后貼上地形數據源:ETOPO5.dat