;; $Id: zip-api.cl,v 1.3 2007/01/11 01:07:39 layer Exp $
;;
;; This software is Copyright (c) Kevin Layer, 2006-2007.
;; You are granted the rights to distribute
;; and use this software as governed by the terms
;; of the Lisp Lesser GNU Public License
;; (http://opensource.franz.com/preamble.html),
;; known as the LLGPL.

;; 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)

;; The first thing we want to do is to define a special that contains the
;; zip code data.  Because of the nature of data, because it contains
;; latitude and longitudes of the zip codes, a likely use of this data will
;; be for searching.  That's why a simple vector was chosen.
;;
;; It would be simple matter to create, at compile time, a simple vector of
;; zip structs.  (This is so the zips.csv file is not needed at load time.)
;; It turns out that because the compiler must do circularity detection and
;; lots of other work, having the compiler write out a simple vector of
;; 33000+ struct objects is a very slow process, one that creates a lot of
;; garbage and uses lots of memory.  So, we use an alternate implementation
;; to read in the zips.csv file so the data can be constructed at load time.
;;
;; The technique used:
;; 
;; At compile time read the zips.csv file, creating a (temporary) simple
;; vector of zip structs.  Then, write the 5 slots of each zip struct into
;; 5 different vectors.  The special *zipcode-data* holds the list of these
;; 5 vectors.  Then, at load time, we create the original vector.
;;
;; It turns out the implementation below is about 10x more efficient
;; in time and more than 10x more efficient in space, than the
;; 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))))

(defvar *zipcodes*
    (destructuring-bind (codes abbrevs locations cities states)
	*zipcode-data*
      (do* ((max (length codes))
	    (zips (make-array max))
	    (i 0 (1+ i)))
	  ((= i max) zips)
	(setf (svref zips i)
	  (make-zip :code (svref codes i)
		    :state-abbrev (svref abbrevs i)
		    :location (let ((loc (svref locations i)))
				(make-location
				 :latitude (car loc)
				 :longitude (cdr loc)))
		    :city (svref cities i)
		    :state (svref states i))))))

(setq *zipcode-data* nil) ;; no longer needed, GC it

(defun location-to-zip (location)
  ;; It turns out that finding the nearest zip for a given location is a
  ;; little tricky.  You can't just do a regular binary search, because
  ;; there are two parameters you are minimizing: latitude and longitude.
  ;; The follow solves the problem by brute force, traverse the entire
  ;; *zipcodes* array looking for the minimum distance between the target
  ;; location and each location in the vector.
  ;;
  (declare (optimize speed))
  (do* ((rlat (location-latitude location))
	(rlon (location-longitude location))
	(i 0 (1+ i))
	(zips *zipcodes*)
	(max (length zips))
	(best-i 0)
	(min-diff 10000.0)
	(lat 0.0)
	(lon 0.0)
	(diff 0.0)
	location zip)
      ((= i max) (svref zips best-i))
    (declare (single-float rlat rlon min-diff lap lon diff)
	     (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))))
