国の形を比べる

CanonicalWarpingDistanceを使って，複数の国の形の類似度を求める．

In[1]:=

names = {"USA", "Poland", "Portugal", "Vietnam", "Brazil", "Finland"}; borders = <|# -> ArrayResample[CountryData[#, "Polygon"][[1, 1, 1]], 200] & /@ names|>;

In[2]:=

shapes = Graphics[CountryData[#, "Shape"][[1]], ImageSize -> {50, 50}] & /@ Keys[borders]

Out[2]=

正準時間伸縮法を使って，形状の距離を計算する．

In[3]:=

dm = DistanceMatrix[Values[borders], DistanceFunction -> (Chop[ CanonicalWarpingDistance[##, MaxIterations -> 6]] &)];

距離行列を表示する．

In[4]:=

MatrixPlot[dm, FrameTicks -> {{MapIndexed[{#2[[1]], #1} &, shapes], None}, {MapIndexed[{#2[[1]], Rotate[#1, \[Pi]/4]} &, names], None}}, Mesh -> True, ColorFunction -> "BlueGreenYellow", PlotLegends -> Automatic, PlotLabel -> "Distance based on country shape", ImageSize -> Medium]

Out[4]=