~mro/geohash

4dc743e04f80079b002789edf160cfeb5737eaec — Marcus Rohrmoser 3 years ago 8e9ded0 
purge legacy
patch browse .tar.gz 
6 files changed, 18 insertions(+), 191 deletions(-)

M bin/cgi.ml
R lib/{calc.ml => geohash.ml}
D lib/iter.ml
M test/dune
R test/{calc_test.ml => geohash_test.ml}
D test/iter_test.ml

M bin/cgi.ml => bin/cgi.ml +2 -2
@@ 26,7 26,7 @@ open Lib.Cgi
let handle_hash req =
  match req.path_info |> String.split_on_char '/' with
  | [ ""; hash ] -> (
      match Lib.Calc.decode hash with
      match Lib.Geohash.decode hash with
      | Error _ -> error 406 "Cannot decode hash."
      | Ok ((lat, lon), (dlat, dlon)) ->
          let mime = "text/xml"


@@ 86,7 86,7 @@ let handle req =
                    |> max 2
                    |> min 12
                  in
                  match co |> Lib.Calc.encode prec with
                  match co |> Lib.Geohash.encode prec with
                  | Error _ -> error 406 "Cannot encode coords."
                  | Ok hash -> hash |> redirect)))
      | _ -> handle_hash req)


R lib/calc.ml => lib/geohash.ml +13 -6
@@ 1,5 1,5 @@
(*
 * calc.ml
 * geohash.ml
 *
 * Created by Marcus Rohrmoser on 11.03.21.
 * Copyright © 2021-2021 Marcus Rohrmoser mobile Software http://mro.name/~me. All rights reserved.


@@ 26,9 26,9 @@ open Optint.Int63

(*
 * 60 bits are fine, because
 * - ocaml has efficient int63 but not int64
 * - 12 geohash characters equal 60 bit
 * - nobody uses 13 chars = 65 bit
 * - 12 geohash characters equal 60 bit
 * - ocaml has efficient int63 but not int64
 *)

(* wgs84 -> 30 bit geohash *)


@@ 68,16 68,23 @@ let interleave (x, y) = spread x |> logor (shift_left (spread y) 1)

let deinterleave x = (squash x, squash (shift_right x 1))

let alphabet = Bytes.of_string "0123456789bcdefghjkmnpqrstuvwxyz"

let b32_int_to_char i = Bytes.get alphabet i

let b32_int_of_char c =
  (* if we want it fast, either do binary search or construct a sparse LUT from chars 0-z -> int *)
  match c |> Bytes.index_opt alphabet with None -> Error c | Some i -> Ok i

let x1f = of_int 0x1f

(* encode the chars * 5 low bits of x *)
let base32_encode chars x =
  let alpha = "0123456789bcdefghjkmnpqrstuvwxyz" in
  let rec f i x' b =
    match i with
    | -1 -> b
    | _ ->
        Bytes.set b i alpha.[x' |> logand x1f |> to_int];
        x' |> logand x1f |> to_int |> b32_int_to_char |> Bytes.set b i;
        f (i - 1) (shift_right x' 5) b
  in
  chars |> Bytes.create |> f (chars - 1) x |> Bytes.to_string


@@ 92,7 99,7 @@ let base32_decode hash =
        | 0 -> Ok x
        | _ ->
            Result.bind
              (hash.[idx] |> Iter.P.b32_int_of_char)
              (hash.[idx] |> b32_int_of_char)
              (fun v -> v |> of_int |> logor (shift_left x 5) |> f (idx + 1))
      in
      f 0 zero


D lib/iter.ml => lib/iter.ml +0 -115
@@ 1,115 0,0 @@
(*
 * iter.ml
 *
 * Created by Marcus Rohrmoser on 16.05.20.
 * Copyright © 2020-2021 Marcus Rohrmoser mobile Software http://mro.name/~me. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

module P = struct
  let b32_int_of_char = function
    | '0' -> Ok 0x00 | '1' -> Ok 0x01 | '2' -> Ok 0x02 | '3' -> Ok 0x03 | '4' -> Ok 0x04
    | '5' -> Ok 0x05 | '6' -> Ok 0x06 | '7' -> Ok 0x07 | '8' -> Ok 0x08 | '9' -> Ok 0x09
    | 'b' -> Ok 0x0a | 'c' -> Ok 0x0b | 'd' -> Ok 0x0c | 'e' -> Ok 0x0d | 'f' -> Ok 0x0e
    | 'g' -> Ok 0x0f | 'h' -> Ok 0x10 | 'j' -> Ok 0x11 | 'k' -> Ok 0x12 | 'm' -> Ok 0x13
    | 'n' -> Ok 0x14 | 'p' -> Ok 0x15 | 'q' -> Ok 0x16 | 'r' -> Ok 0x17 | 's' -> Ok 0x18
    | 't' -> Ok 0x19 | 'u' -> Ok 0x1a | 'v' -> Ok 0x1b | 'w' -> Ok 0x1c | 'x' -> Ok 0x1d
    | 'y' -> Ok 0x1e | 'z' -> Ok 0x1f
    | ch  -> Error ch

  let b32_int_to_char = function
    | 0x00 -> "0" | 0x01 -> "1" | 0x02 -> "2" | 0x03 -> "3" | 0x04 -> "4"
    | 0x05 -> "5" | 0x06 -> "6" | 0x07 -> "7" | 0x08 -> "8" | 0x09 -> "9"
    | 0x0a -> "b" | 0x0b -> "c" | 0x0c -> "d" | 0x0d -> "e" | 0x0e -> "f"
    | 0x0f -> "g" | 0x10 -> "h" | 0x11 -> "j" | 0x12 -> "k" | 0x13 -> "m"
    | 0x14 -> "n" | 0x15 -> "p" | 0x16 -> "q" | 0x17 -> "r" | 0x18 -> "s"
    | 0x19 -> "t" | 0x1a -> "u" | 0x1b -> "v" | 0x1c -> "w" | 0x1d -> "x"
    | 0x1e -> "y" | 0x1f -> "z"
    | _    -> "-"

  let world = ((-180., 180.), (-90., 90.))

  let mid = function a, b -> (a +. b) /. 2.

  let span = function mi, ma -> (ma -. mi) /. 2.

  (* which bucket/quadrant to go on with *)
  let middle_earth do_lon area hi =
    let lon, lat = area and (lo0, lo1), (la0, la1) = area in
    match (do_lon, hi) with
    | true, true -> ((mid lon, lo1), lat)
    | true, false -> ((lo0, mid lon), lat)
    | false, true -> (lon, (mid lat, la1))
    | false, false -> (lon, (la0, mid lat))

  (* Decode a chunk of 5 bits and refine the area. *)
  let rec decode_bits bits idx lon_off area =
    match idx with
    | -1 -> area
    | _ ->
        0
        != bits land (1 lsl idx)
        |> middle_earth (lon_off = idx mod 2) area
        |> decode_bits bits (idx - 1) lon_off

  (* Decode one character of a geohash and refine the area. *)
  let rec decode_chars hash idx stop area' =
    Result.bind area' (fun area ->
        match idx = stop with
        | true -> area'
        | _ ->
            Result.bind
              (idx |> String.get hash |> b32_int_of_char)
              (fun bits ->
                Ok (decode_bits bits 4 (idx mod 2) area)
                |> decode_chars hash (idx + 1) stop))

  (* Recurse per bit, encode either lon (even) or lat (odd)
   * and add chunks of 5 bits to a list to be returned finally. *)
  let rec encode_wrk pt charsleft step bits ret area =
    match charsleft with
    | 0 -> ret
    | _ -> (
        let do_lon = 0 = step mod 2 in
        let hi =
          match (do_lon, pt, area) with
          | true, (lo, _), (lon, _) -> lo >= mid lon
          | false, (_, la), (_, lat) -> la >= mid lat
        in
        let area' = middle_earth do_lon area hi and sm5 = step mod 5 in
        let bits' =
          bits lor match hi with true -> 1 lsl (4 - sm5) | false -> 0
        in
        match sm5 with
        | 4 ->
            encode_wrk pt (charsleft - 1) (step + 1) 0
              (ret |> List.cons bits')
              area'
        | _ -> encode_wrk pt charsleft (step + 1) bits' ret area')
end

let encode chars (lat, lon) =
  let area = P.world in
  (* check coord inclusion? *)
  Ok
    (P.encode_wrk (lon, lat) chars 0 0 [] area
    |> List.rev |> List.map P.b32_int_to_char |> String.concat "")

let decode hash =
  Result.bind
    (P.decode_chars hash 0 (String.length hash) (Ok P.world))
    (fun (lon, lat) ->
      let op f = (f lat, f lon) in
      Ok (op P.mid, op P.span))


M test/dune => test/dune +1 -2
@@ 1,8 1,7 @@
; http://cumulus.github.io/Syndic/syndic/Syndic__/Syndic_atom/
(tests
 (names
   iter_test
   calc_test
   geohash_test
   cgi_test
   route_test
 )


R test/calc_test.ml => test/geohash_test.ml +2 -2
@@ 1,5 1,5 @@
(*
 * math_test.ml
 * geohash_test.ml
 *
 * Created by Marcus Rohrmoser on 11.03.21.
 * Copyright © 2021-2021 Marcus Rohrmoser mobile Software http://mro.name/~me. All rights reserved.


@@ 19,7 19,7 @@
 *)

open Optint.Int63
open Lib.Calc
open Lib.Geohash

let assert_equals_int64 (test_name : string) (expected : t) (result : t) : 'a =
  Assert.assert_equals test_name to_string expected result


D test/iter_test.ml => test/iter_test.ml +0 -64
@@ 1,64 0,0 @@
(*
 * iter_test.ml
 *
 * Created by Marcus Rohrmoser on 16.05.20.
 * Copyright © 2020-2021 Marcus Rohrmoser mobile Software http://mro.name/~me. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Lib

let () = assert (1 + 1 = 2)

let test_encode_sunshine () =
  (* https://github.com/francoisroyer/ocaml-geohash/blob/master/geohash.ml#L200 *)
  (57.649111, 10.407440) |> Iter.encode 26 |> Result.get_ok
  |> Assert2.equals_string "test_encode_sunshine #0"
       "u4pruydqqvjwpq9g1m5qtr1000";
  (57.649111, 10.407440) |> Iter.encode 11 |> Result.get_ok
  |> Assert2.equals_string "test_encode_sunshine #1" "u4pruydqqvj";
  (57.649111, 10.407440) |> Iter.encode 5 |> Result.get_ok
  |> Assert2.equals_string "test_encode_sunshine #2" "u4pru";
  (57.649111, 10.407440) |> Iter.encode 2 |> Result.get_ok
  |> Assert2.equals_string "test_encode_sunshine #3" "u4"

let test_decode_sunshine () =
  (* https://github.com/francoisroyer/ocaml-geohash/blob/master/geohash.ml#L200 *)
  (let (lat, lon), (dlat, dlon) =
     "u4pruydqqvj" |> Iter.decode |> Result.get_ok
   in
   Assert2.equals_float "lat 0" 57.649111 lat 1e-6;
   Assert2.equals_float "lon 0" 10.407440 lon 1e-6;
   Assert2.equals_float "dlat 0" 6.70552253723e-07 dlat 1e-17;
   Assert2.equals_float "dlon 0" 6.70552253723e-07 dlon 1e-17);
  (* https://github.com/mariusae/ocaml-geohash/blob/master/lib_test/test.ml#L7 *)
  let (lat, lon), (dlat, dlon) = "9q8yyk8yuv" |> Iter.decode |> Result.get_ok in
  Assert2.equals_float "lat 1" 37.7749295 lat 1e-5;
  Assert2.equals_float "lon 1" (-122.419415116) lon 1e-6;
  Assert2.equals_float "dlat 1" 2.68220901489e-06 dlat 1e-17;
  Assert2.equals_float "dlon 1" 5.36441802979e-06 dlon 1e-16

let test_decode_failure () =
  (* https://github.com/francoisroyer/ocaml-geohash/blob/master/geohash.ml#L200 *)
  match Iter.decode "u4prUydqqvj" with
  | Ok _ -> assert false
  | Error ch -> assert (ch = 'U')

(* test string to int64 + prec *)

let () =
  test_encode_sunshine ();
  test_decode_sunshine ();
  test_decode_failure ()