Skip to content

Instantly share code, notes, and snippets.

@SaitoAtsushi
Created February 25, 2021 06:13
Show Gist options
  • Save SaitoAtsushi/cb289320a7b7fbeec687546af4d44d74 to your computer and use it in GitHub Desktop.
Save SaitoAtsushi/cb289320a7b7fbeec687546af4d44d74 to your computer and use it in GitHub Desktop.
Geo3x3 in Scheme (R6RS)
#!r6rs
(library (geo3x3)
(export encode decode)
(import (rnrs))
(define (encode lat lng level)
(assert (real? lat))
(assert (real? lng))
(assert (integer? level))
(assert (> level 0))
(call-with-string-output-port
(lambda(port)
(display (if (>= lng 0) "E" "W") port)
(let loop ((i 1)
(lng (exact (mod lng 180)))
(lat (- 90 (exact lat)))
(unit (/ 180 3)))
(when (< i level)
(let-values (((x xr) (div-and-mod lng unit))
((y yr) (div-and-mod lat unit)))
(display (+ x (* y 3) 1) port)
(loop (+ i 1) xr yr (/ unit 3))))))))
(define (digit->integer ch)
(- (char->integer ch)
(char->integer #\0)))
(define (decode code)
(assert (string? code))
(call-with-port (open-string-input-port code)
(lambda(port)
(let ((head (read-char port)))
(assert (or (char=? head #\W) (char=? head #\E)))
(let loop ((level 1)
(lng 0)
(lat 0)
(unit 180)
(ch (read-char port)))
(cond ((eof-object? ch)
(values (inexact (- 90 (+ lat (/ unit 2))))
(- (inexact (+ lng (/ unit 2)))
(if (char=? head #\W) 180 0))
level
(inexact unit)))
(else
(assert (char<=? #\1 ch #\9))
(let* ((n (- (digit->integer ch) 1)))
(let-values (((y x) (div-and-mod n 3))
((unit) (/ unit 3)))
(loop (+ level 1)
(+ lng (* x unit))
(+ lat (* y unit))
unit
(read-char port)))))))))))
)
#!r6rs
(import (rnrs)
(geo3x3))
(let-values ((result (decode "W28644")))
(write result))
(newline)
(let-values ((result (decode "E28644")))
(write result))
(newline)
(write (encode 40 -86.2962962962963 6)) (newline)
(write (encode 40 93.7037037037037 6)) (newline)
(write (encode 40 93.7037037037037 1)) (newline)
(write (encode 40 93.7037037037037 2)) (newline)
(write (encode 40 93.7037037037037 3)) (newline)
(write (encode 40 93.7037037037037 4)) (newline)
(write (encode 40 93.7037037037037 5)) (newline)
(write (encode 40 93.7037037037037 6)) (newline)
(write (encode 40 93.7037037037037 7)) (newline)
(write (encode 40 93.7037037037037 8)) (newline)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment