高梁川にかつて存在した渡船場をWolfram言語でPlot

2020-03-09

GoogleEarth Mathematica WolframCloud 地理院地図 渡船

t f B! P L

岡山県の主要河川の一つ高梁川にかつて存在した渡し船の位置をWolframCloud環境を用いてプロットしてみた。


高梁川に最後まで残っていた渡船「水江の渡し」
署名運動も叶わず2016/03/31で運行を終了した。


倉敷観光Web(筆者が写っていてびっくり)
https://www.kurashiki-tabi.jp/blog/13094/

高梁川
https://ja.wikipedia.org/wiki/%E9%AB%98%E6%A2%81%E5%B7%9D

渡し船
https://ja.wikipedia.org/wiki/%E6%B8%A1%E3%81%97%E8%88%B9



明治、大正、昭和時代に発行された国土地理院の地形図には渡船場の位置が記されている。


河川に描かれた小舟のマークが渡船場を示している。
土手をおり河川敷を進んだのち渡船場というケースも多い。
近くに水深表示があることが多い。

現在はほとんどの渡船場は消滅してしまったので地理院地図を見てもこのマークはほとんど見当たらない。これに反して昔の地形図は随所に渡船場の記号がある。川についても渡るときのことを意識した実践的な表記が多い。





ところどころの欠落が惜しいが、古い時代の地形図がスタンフォード大学のサイトで公開されている。
https://stanford.maps.arcgis.com/apps/SimpleViewer/index.html?appid=733446cc5a314ddf85c59ecc10321b41





詳細を押すと5万図が開く。きれいにスキャンされていて高解像度でダウンロードもできるようになっている。フルスクリーンにして眺めるとタイムスリップ感がしみじみ楽しい。拡大の際は必要な部分だけがロードされるようで快適に閲覧できる。
年代別に複数の地形図が登録されているわけではないもよう(探せばあるのかも)
欄外に参謀本部とあるので接収されたものだろうか。右上には「秘」の文字が。







 超高解像度でのダウンロードもできる。


ただ、画像として存在してるだけなのでクリックして座標をつかむことはできない。そこで別画面で地理院地図を開き、人の目で見比べながら対応位置を確認し地理院地図の左下に表示される緯度経度をコピペで取得した。



In[]: = watashi = {
   {"嘉左衛門渡右", 1.6, 1925, {34.58127, 133.71104}},
   {"嘉左衛門渡左", 0.6, 1925, {34.58045, 133.71473}},
   {"又串渡",     1.0, 1925, {34.59404, 133.72378}},
   {"水江渡",         , 1925, {34.60278, 133.73381}},
   {"中原渡",      2.5, 1925, {34.66432, 133.72771}},
   {"上原渡",      3.0, 1925, {34.67411, 133.71770}},
   {"西田渡",      3.0, 1925, {34.67690, 133.71564}},
   {"六本渡",      1.6, 1925, {34.68764, 133.72512}},
   {"(井神社)",    8.8, 1925, {34.69479, 133.72836}},
   {"(茶臼岳)",    1.8, 1925, {34.70293, 133.71947}},
   {"(上條)",        2.4, 1925, {34.70977, 133.70644}},
   {"(日羽)",        2.4, "S.7", {34.71502, 133.68083}},
   {"(下村)",        2.5, "S.7", {34.717276, 133.660794}},
   {"(美袋)",        , "S.7", {34.719110, 133.64322}},
   {"(上村)",        , "S.7", {34.725671, 133.63973}},
   {"(種井)",        , "S.7", {34.740308, 133.64094}},
   {"(下組)",        , "S.7", {34.787180, 133.60919}},
   {"(陰地)",        , "S.7", {34.793065, 133.61245}},
   {"(八長)",        1.6, "S.7", {34.808307, 133.615626}},
   {"(谷合)",        , "S.7", {34.919473, 133.522629}},
   {"(肉谷)",        , "S.7", {34.829446, 133.60556}},
   {"(姫原)",        , "S.7", {34.931137, 133.50580}},
   {"(小瀬)",        , "S.7", {34.779337, 133.571295}},
   {"(白谷)",        , "S.7", {34.784730, 133.549644}},
   {"(星原)",        , "S.7", {34.779672, 133.52398}}
   };


In[]: = Grid[watashi[[Range[Length[watashi]], {1, 4}]], Frame -> All]

Out[] =

一部成羽川も含めているが地図に残っているだけで25箇所も。

高梁川はこれとは別に備中松山藩が玉島港を結んで交易に用いた高瀬舟の運行でも有名である。水江の渡しのすぐ近くに高梁川と並行して走る水路に石造りの閘門の跡(高瀬通し)がしっかり残っている。下流側をせき止めて水を流し区間の水位を上げ、上流側の水位まで船が上がったら先へ進むというしくみはパナマ運河やスエズ運河より2百年近く早く完成していたとのこと。高瀬舟は太正14年に国鉄伯備線が開通するまで運行されていたそうなので実物を見た人がまだ生きているかもしれない。


一度リストにしてしまえばあとは簡単に値が取り出せる。

In[]: = Length[watashi]
Out[] = 25

In[]: = Text[watashi[[1, 1]]]
Out[] = 嘉左衛門渡右

In[]: = watashi[[1, 4]]
Out[] = {34.5813, 133.711}

グラフィックス要素の透明度や色を変える際は要素よりも前に並べる。

In[]: = GeoGraphics[{
  {Opacity[1], Black,
   Text[watashi[[2, 1]], GeoPosition[watashi[[2, 4]]]]}, Opacity[0.3],
   Red, {Disk[GeoPosition[watashi[[2, 4]]], 0.001]}
  , {Opacity[1], Black,
   Text[watashi[[4, 1]], GeoPosition[watashi[[4, 4]]]]}, Opacity[0.3],
   Red, {Disk[GeoPosition[watashi[[4, 4]]], 0.001]}
  , {Opacity[1], Black,
   Text[watashi[[5, 1]], GeoPosition[watashi[[5, 4]]]]}, Opacity[0.3],
   Red, {Disk[GeoPosition[watashi[[5, 4]]], 0.001]}
  , {Opacity[1], Black,
   Text[watashi[[8, 1]], GeoPosition[watashi[[8, 4]]]]}, Opacity[0.3],
   Red, {Disk[GeoPosition[watashi[[8, 4]]], 0.001]}
  }]


Out[] =



一般に、リストに対してある関数fを適用したい場合は
In[]: = f[#] & /@ {1, 2, 3}
Out[] = {f[1],f[2],f[3]}
のように記述できる。
#は引数、複数ある場合は#1,#2などとする。
&はこれが関数ですよというしるし。

Map[f,expr]または f/@expr を使うと
expr の第1レベルにある各要素に f を適用することができる。


上の例で2,4,5,8番目の渡船場について一箇所ずつ作図したが
GeoGraphicsで描画するという関数をリストに対して適用すると考えれば

In[]: = GeoGraphics[{

    Opacity[0.3], Red,
    Disk[GeoPosition[watashi[[#, 4]]], 0.03],
    Opacity[#], Black,
    Text[watashi[[#, 1]], GeoPosition[watashi[[#, 4]]]]
    }] & /@ {2, 4, 5, 8}

とシンプルに書ける。

Out[] =



GeoGraphicsのカッコの中に入れれば一つの地図の中に入る。

In[]: = GeoGraphics[
{ Opacity[0.3], Red
, Disk[GeoPosition[watashi[[#, 4]]], 0.008]
, Opacity[1.0], Black
, Text[watashi[[#, 1]], GeoPosition[watashi[[#, 4]]]]
} &/@ {2, 4, 5, 8}
     ]
Out[] =


GeoGraphicsの背景はオプションで様々に指定できる。
GeoGraphics[expr,GeoBackground->”StreetMap”] 指定しなければこれになる。
GeoGraphics[expr,GeoBackground->”ReliefMap”] 
GeoGraphics[expr,GeoBackground->”Satellite”] 
GeoGraphics[expr,GeoBackground->”Satellite”,GeoServer->"DigitalGrobe"] 
他にも色々あり

Satelliteだけだと粗くてぼけぼけだが、DigitalGrobeをGeoServerに指定すると
とてもきれいな衛星画像となる。利用料金はWRIが払っているのだろうか?

In[]: = GeoGraphics[
{Opacity[0.3], Red, Disk[GeoPosition[watashi[[#, 4]]], 0.008]
    , Opacity[1.0], Yellow,
    Text[watashi[[#, 1]], GeoPosition[watashi[[#, 4]]]]} &
  /@ {2, 4, 5, 8}, GeoBackground -> "Satellite",
GeoServer -> "DigitalGlobe"]

Out[] =


Length[]とRange[]を組み合わせれば
全ての渡船場の指標を示すリストになるので
In[]: = Range[Length[watashi]]
{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25}

結局このようにやれば全ての渡船場が描画できた。

In[]: = GeoGraphics[
{Opacity[0.3], Red, Disk[GeoPosition[watashi[[#, 4]]], 0.008]
    , Opacity[1.0], Yellow,
    Text[watashi[[#, 1]], GeoPosition[watashi[[#, 4]]]]} &
  /@ Range[Length[watashi]], GeoBackground -> "Satellite",
GeoServer -> "DigitalGlobe"]


Out[] =

QooQ