前回のエントリーで,逆ジオコーディングの精度を高めるため,隣接8ブロックを求める考え方を示しました。
今回はそのアルゴリズムにしたがって関数を作成します。
関数名:NeighborBlock
戻り値:隣接ブロックのジオハッシュ(エラーは#N/A)
引数1:元のジオハッシュ
引数2:隣接の方向
隣接の方向は中心を0とし,下図のように定義します。左下から反時計回りに1〜8としています。
末尾のハッシュをLastHash,末尾より上位をBeforeLastHashとして分割します。
元のジオハッシュから見て,隣接の方向を考慮して末尾のハッシュ文字を置き換えますが,その組合せをひたすら分岐処理により分けています。
その組合せは,桁数が偶数の場合と奇数の場合,末尾のジオハッシュ32通り,隣接方向8方向で,2×32×8となっています。(繰り返し部は省略)
同一桁の32ブロックからはみ出して隣の32ブロックになる場合は,上位ハッシュを再帰処理することにより実現しています。
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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
Function NeighborBlock(ByVal Hash As String, ByVal N As Integer) '隣接番号N=1~8、それ以外はエラー終了 If N < 1 Or N > 8 Then NeighborBlock = "#N/A" Exit Function End If Dim NB As String Dim LastHash As String, BeforeLastHash As String Dim Digits As Integer Digits = Len(Hash) 'ジオハッシュの桁数 LastHash = Right$(Hash, 1) 'ジオハッシュの末尾1文字 BeforeLastHash = Left$(Hash, Digits - 1) '末尾一桁を除く上位ハッシュ Select Case Digits Mod 2 Case 0 '桁数が偶数の場合、縦8×横4分割 Select Case LastHash '最後の1文字ごとに分岐 Case "0" Select Case N Case 1: NB = NeighborBlock(BeforeLastHash, 1) & "z" Case 2: NB = NeighborBlock(BeforeLastHash, 2) & "p" Case 3: NB = NeighborBlock(BeforeLastHash, 2) & "r" Case 4: NB = BeforeLastHash & "2" Case 5: NB = BeforeLastHash & "3" Case 6: NB = BeforeLastHash & "1" Case 7: NB = NeighborBlock(BeforeLastHash, 8) & "c" Case 8: NB = NeighborBlock(BeforeLastHash, 8) & "b" Case Else: NeighborBlock = "#N/A": Exit Function End Select Case "1" '以下32文字分繰り返す Case Else: NeighborBlock = "#N/A": Exit Function End Select Case 1 '桁数が奇数の場合、縦4×横8分割 Select Case LastHash '最後の1文字ごとに分岐 Case "0" Select Case N Case 1: NB = NeighborBlock(BeforeLastHash, 1) & "z" Case 2: NB = NeighborBlock(BeforeLastHash, 2) & "b" Case 3: NB = NeighborBlock(BeforeLastHash, 2) & "c" Case 4: NB = BeforeLastHash & "1" Case 5: NB = BeforeLastHash & "3" Case 6: NB = BeforeLastHash & "2" Case 7: NB = NeighborBlock(BeforeLastHash, 8) & "r" Case 8: NB = NeighborBlock(BeforeLastHash, 8) & "p" Case Else: NeighborBlock = "#N/A": Exit Function End Select Case "1" '以下32文字分繰り返す Case Else: NeighborBlock = "#N/A": Exit Function End Select End Select NeighborBlock = NB End Function |