[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/a9Uj7oPj    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Dec 9:
; 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")))


Output:
1
with-input-from-file: cannot open input file: "/santa-track.txt" (No such file or directory; errno=2)


Create a new paste based on this one


Comments: