codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; tracking santa (define pi 3.1415926535897936) (define (atan2 y x) (let* ((-pi (- pi)) (pi/2 (/ pi 2)) (-pi/2 (- pi/2))) (cond ((positive? x) (atan (/ y x))) ((negative? y) (if (zero? x) -pi/2 (+ (atan (/ y x)) -pi))) (else (if (zero? x) pi/2 (+ (atan (/ y x)) pi)))))) (define (string-find pat str . s) (let* ((plen (string-length pat)) (slen (string-length str)) (skip (make-vector plen 0))) (let loop ((i 1) (j 0)) (cond ((= i plen)) ((char=? (string-ref pat i) (string-ref pat j)) (vector-set! skip i (+ j 1)) (loop (+ i 1) (+ j 1))) ((< 0 j) (loop i (vector-ref skip (- j 1)))) (else (vector-set! skip i 0) (loop (+ i 1) j)))) (let loop ((p 0) (s (if (null? s) 0 (car s)))) (cond ((= s slen) #f) ((char=? (string-ref pat p) (string-ref str s)) (if (= p (- plen 1)) (- s plen -1) (loop (+ p 1) (+ s 1)))) ((< 0 p) (loop (vector-ref skip (- p 1)) s)) (else (loop p (+ s 1))))))) (define (read-line . port) (define (eat p c) (if (and (not (eof-object? (peek-char p))) (char=? (peek-char p) c)) (read-char p))) (let ((p (if (null? port) (current-input-port) (car port)))) (let loop ((c (read-char p)) (line '())) (cond ((eof-object? c) (if (null? line) c (list->string (reverse line)))) ((char=? #\newline c) (eat p #\return) (list->string (reverse line))) ((char=? #\return c) (eat p #\newline) (list->string (reverse line))) (else (loop (read-char p) (cons c line))))))) (define (dist pt1 pt2) (define (d->r d) (* d pi 1/180)) (define (square x) (* x x)) (let* ((lat1 (car pt1)) (lng1 (cdr pt1)) (lat2 (car pt2)) (lng2 (cdr pt2)) (r 6371) ; radius of "perfect" earth in kilometers (dlat (d->r (- lat2 lat1))) (dlng (d->r (- lng2 lng1))) (a (+ (* (sin (/ dlat 2)) (sin (/ dlat 2))) (* (cos (d->r lat1)) (cos (d->r lat2)) (square (sin (/ dlng 2)))))) (c (* 2 (atan2 (sqrt a) (sqrt (- 1 a)))))) (inexact->exact (round (* r c))))) (define (read-route filename) ; http://www.noradsanta.org/js/data.js (with-input-from-file filename (lambda () (let loop ((line (read-line)) (ps '())) (cond ((eof-object? line) (reverse ps)) ((string-find "\"lat\"" line) (let* ((lat (string->number (substring line 12 (- (string-length line) 2)))) (line (read-line)) (lng (string->number (substring line 12 (- (string-length line) 2))))) (loop (read-line) (cons (cons lat lng) ps)))) (else (loop (read-line) ps))))))) (define (route-length route) (let loop ((start (car route)) (rest (cdr route)) (len 0)) (if (null? rest) (inexact->exact (round (* len .621371192))) (loop (car rest) (cdr rest) (+ (dist start (car rest)) len))))) (display (route-length (read-route "santa-track.txt")))
Private
[
?
]
Run code
Submit