diff -u -r usgs/google/google-maps.cl usgs.final/google/google-maps.cl --- usgs/google/google-maps.cl 2007-01-16 07:15:50.000000000 -0800 +++ usgs.final/google/google-maps.cl 2007-01-19 17:42:22.000000000 -0800 @@ -72,9 +72,20 @@ :latitude (read-from-string lat) :longitude (read-from-string lon))))))) -(defun location-to-place (location) +(defun location-to-place (location &key with-offset-p) (let ((zip (location-to-zip location))) (when zip - (format nil "~@[~a, ~]~a" - (zip-city zip) - (zip-state zip))))) + (if (or with-offset-p (not (zip-city zip))) + (let* ((city-location (city-location (zip-city zip) (zip-state zip))) + (distance (distance-between location city-location))) + (format nil "~,1F miles ~A of ~@[~a, ~]~a" + distance + (bearing-to-direction (bearing-to city-location location)) + (zip-city zip) + (zip-state zip))) + (format nil "~@[~a, ~]~a" + (zip-city zip) + (zip-state zip)))))) + +(defun city-location (city state) + (place-to-location (format nil "~A, ~A, US" city state))) diff -u -r usgs/measures/measures.cl usgs.final/measures/measures.cl --- usgs/measures/measures.cl 2007-01-10 20:19:30.000000000 -0800 +++ usgs.final/measures/measures.cl 2007-01-19 18:17:54.000000000 -0800 @@ -13,7 +13,8 @@ #:location-latitude #:location-longitude #:make-location - + #:bearing-to + #:bearing-to-direction #:distance-between #:location-near-p)) @@ -74,3 +75,38 @@ (* radius (acos (+ (* (sin lat1) (sin lat2)) (* (cos lat1) (cos lat2) (cos (- lon2 lon1))))))))) + +;; From http://williams.best.vwh.net/avform.htm#Crs +(defun bearing-to (location1 location2) + (flet ((radians (deg) (* deg (/ pi 180.0))) + (degrees (rad) (* rad (/ 180.0 pi)))) + (let ((lat1 (radians (location-latitude location1))) + (lon1 (radians (location-longitude location1))) + (lat2 (radians (location-latitude location2))) + (lon2 (radians (location-longitude location2)))) + (degrees (mod (atan (* (sin (- lon2 lon1)) (cos lat2)) + (- (* (cos lat1) (sin lat2)) + (* (sin lat1) (cos lat2) (cos (- lon2 lon1))))) + (* 2 pi)))))) + +(defparameter *directions* + '(("N" . 0) + ("NE" . 45) + ("E" . 90) + ("SE" . 135) + ("S" . 180) + ("SW" . 225) + ("W" . 270) + ("NW" . 315))) + +(defun bearing-to-direction (bearing) + (let ((best nil) + (best-diff 0)) + (dolist (dir *directions*) + (let ((direction (car dir)) + (heading (cdr dir))) + (when (or (null best) + (< (abs (- bearing heading)) best-diff)) + (setf best direction) + (setf best-diff (abs (- bearing heading)))))) + best)) diff -u -r usgs/usgs.cl usgs.final/usgs.cl --- usgs/usgs.cl 2007-01-15 14:28:25.000000000 -0800 +++ usgs.final/usgs.cl 2007-01-19 17:34:30.000000000 -0800 @@ -85,7 +85,7 @@ (or (null larger-than) (> magnitude larger-than))) (format t "~a: ~a: magnitude=~a~%" - date (location-to-place location) + date (location-to-place location :with-offset-p T) magnitude) #+ignore (push (list date (location-to-place location) diff -u -r usgs/zipcodes/zip-api.cl usgs.final/zipcodes/zip-api.cl --- usgs/zipcodes/zip-api.cl 2007-01-10 17:07:39.000000000 -0800 +++ usgs.final/zipcodes/zip-api.cl 2007-01-19 17:43:20.000000000 -0800 @@ -9,10 +9,6 @@ ;; This file defines the API for the `zipcodes' module. -(eval-when (compile) - (load (merge-pathnames "zip-package.fasl" *compile-file-pathname*)) - (load (merge-pathnames "zip-util.fasl" *compile-file-pathname*))) - (provide :zipcodes) (in-package :util.zipcodes) @@ -42,22 +38,22 @@ ;; simple-vector or structs written out by the compiler. (defvar *zipcode-data* - #.(let ((zips - (prog2 - (progn (format t "reading zips.cvs...") - (force-output)) - (read-zips-csv - (merge-pathnames "zips.csv" *compile-file-pathname*)) - (format t "done~%")))) - (list 'list - (vector-of zips #'zip-code) - (vector-of zips #'zip-state-abbrev) - (vector-of zips (lambda (zip) - (let ((loc (zip-location zip))) - (cons (location-latitude loc) - (location-longitude loc))))) - (vector-of zips #'zip-city) - (vector-of zips #'zip-state)))) + (let ((zips + (prog2 + (progn (format t "reading zips.cvs...") + (force-output)) + (read-zips-csv + (merge-pathnames "zips.csv" *load-pathname*)) + (format t "done~%")))) + (list + (vector-of zips #'zip-code) + (vector-of zips #'zip-state-abbrev) + (vector-of zips (lambda (zip) + (let ((loc (zip-location zip))) + (cons (location-latitude loc) + (location-longitude loc))))) + (vector-of zips #'zip-city) + (vector-of zips #'zip-state)))) (defvar *zipcodes* (destructuring-bind (codes abbrevs locations cities states) @@ -103,12 +99,19 @@ (fixnum i max best-i)) (setq zip (svref zips i)) (setq location (zip-location zip)) - (setq lat (location-latitude location)) - (setq lon (location-longitude location)) - (setq diff - (the single-float - (+ (the single-float (abs (the single-float (- lat rlat)))) - (the single-float (abs (the single-float (- lon rlon))))))) - (when (< diff min-diff) - (setq best-i i) - (setq min-diff diff)))) + ;; Skip zips that don't have a city (these correspond to ZCTA + ;; codes followed by an "HH" or "XX" suffix, which are not + ;; actually zip codes, and are "...generally rural areas with + ;; little settlement; for example, parks, forest lands, and desert + ;; and mountainous areas." See + ;; http://www.census.gov/geo/ZCTA/zctafaq.html#Q11 + (when (zip-city zip) + (setq lat (location-latitude location)) + (setq lon (location-longitude location)) + (setq diff + (the single-float + (+ (the single-float (abs (the single-float (- lat rlat)))) + (the single-float (abs (the single-float (- lon rlon))))))) + (when (< diff min-diff) + (setq best-i i) + (setq min-diff diff))))) diff -u -r usgs/zipcodes/zip-util.cl usgs.final/zipcodes/zip-util.cl --- usgs/zipcodes/zip-util.cl 2007-01-10 17:07:39.000000000 -0800 +++ usgs.final/zipcodes/zip-util.cl 2007-01-19 17:38:23.000000000 -0800 @@ -9,9 +9,6 @@ ;; This file contains utilities used only at compile time. -(eval-when (compile) - (load (merge-pathnames "zip-package.fasl" *compile-file-pathname*))) - (in-package :util.zipcodes) (defun read-zips-csv (csv-file) diff -u -r usgs/zipcodes/zipcodes.asd usgs.final/zipcodes/zipcodes.asd --- usgs/zipcodes/zipcodes.asd 2007-01-10 16:05:56.000000000 -0800 +++ usgs.final/zipcodes/zipcodes.asd 2007-01-19 17:38:23.000000000 -0800 @@ -1,5 +1,5 @@ (defsystem zipcodes :components ((:file "zip-package") - (:file "zip-util") - (:file "zip-api")) + (:file "zip-util" :depends-on ("zip-package")) + (:file "zip-api" :depends-on ("zip-package" "zip-util"))) :depends-on ("measures"))