Gaucheでgeohash

Gaucheでgeohashデコードする。

一応動くようになった。
ちゃんとモジュールにするのはまだ勉強してない。これからやる。
てか、ブロッガってtarのアップロードできないのね。。。
ソースべたで張るよ。

#!/usr/bin/env gosh
;; Copyright (c) 2008 KOGA Kazuo
;; MIT License
;;
;; Geohash
;; see http://en.wikipedia.org/wiki/Geohash
;;

(use gauche.sequence)
(use gauche.collection)
(use gauche.uvector)

(define (medium x y) (/ (+ x y) 2))

(define (interval-choice which min max)
  (if (= 0 which)
      (values min (medium min max))
      (values (medium min max) max)))

(define (interval-fold code min max)
  (fold2 interval-choice min max
         code))

(define (interval-fold-fold codes min max)
  (fold2 interval-fold min max
         codes))

(define base32-base
  #(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7
    #\8 #\9 #\b #\c #\d #\e #\f #\g
    #\h #\j #\k #\m #\n #\p #\q #\r
    #\s #\t #\u #\v #\w #\x #\y #\z))
(define base32-bits
  #(   #u8(0 0 0 0 0) #u8(0 0 0 0 1) #u8(0 0 0 1 0) #u8(0 0 0 1 1)
       #u8(0 0 1 0 0) #u8(0 0 1 0 1) #u8(0 0 1 1 0) #u8(0 0 1 1 1)
       #u8(0 1 0 0 0) #u8(0 1 0 0 1) #u8(0 1 0 1 0) #u8(0 1 0 1 1)
       #u8(0 1 1 0 0) #u8(0 1 1 0 1) #u8(0 1 1 1 0) #u8(0 1 1 1 1)
       #u8(1 0 0 0 0) #u8(1 0 0 0 1) #u8(1 0 0 1 0) #u8(1 0 0 1 1)
       #u8(1 0 1 0 0) #u8(1 0 1 0 1) #u8(1 0 1 1 0) #u8(1 0 1 1 1)
       #u8(1 1 0 0 0) #u8(1 1 0 0 1) #u8(1 1 0 1 0) #u8(1 1 0 1 1)
       #u8(1 1 1 0 0) #u8(1 1 1 0 1) #u8(1 1 1 1 0) #u8(1 1 1 1 1)
       ))

(define (pos-even?)
  (let1 even #f
    (lambda (_)
      (set! even (not even))
      even)))

(define (decode-base32 s)
  (map (lambda (c)
         (ref base32-bits
              (find-index (cut eqv? c <>) base32-base)))
       s))

(define (geohash-decode str)
  "geohash => longitude latitude"
  (let ((bits (decode-base32 str))
        (pos (pos-even?)))
    (let loop ((b bits)
               (lon-min -180.0)
               (lon-max 180.0)
               (lat-min -90.0)
               (lat-max 90.0))
      (if (null? b)
          (values (medium lon-min lon-max)
                  (medium lat-min lat-max))
          (receive (lon lat)
              (partition pos (car b))
            (receive (lomin lomax)
                (interval-fold lon lon-min lon-max)
              (receive (lamin lamax)
                  (interval-fold lat lat-min lat-max)
                (loop (cdr b)
                      lomin lomax lamin lamax))))))))
#?=
(geohash-decode "ezs42")