solution-less-naive

luhn-will.lisp

;;------------------------------------------------------------------------------
(eval-when (:compile-toplevel)
  (ql:quickload :series))

(defpackage luhn 
  (:use :cl :series))

(in-package :luhn)

;;-- sums integer digits as long as x is < 100.
(defun sum-digits<100 (x)
  (multiple-value-bind (n rem)
      (floor (/ (2* x) 10))
    (+ n (* rem 10))))

;;-- double the numbers in a series
(defun double-series (s)
  (labels ((2* (x) (+ x x)))
    (map-fn t #'2* s)))

;;-- binds an odd/even-key-series to a body.
(defmacro with-summed-odd/even-key-series (args ds mode &body body)
  (let ((odd-series/sym (gensym))
	(even-series/sym (gensym)))
    `(multiple-value-bind (,odd-series/sym ,even-series/sym)
	 (split (scan ,ds) (series t nil))
       ,(let ((odd/sym (elt args 0))
	      (even/sym (elt args 1)))
	  (cond ((eq mode :double-odd)
		 `(progn
		    (setf ,odd/sym (double-series ,odd-series/sym)
			  ,even/sym ,even-series/sym)
		    ,@body))
		((eq mode :double-even)
		 `(progn
		    (setf ,odd/sym ,odd-series/sym
			  ,even/sym (double-series ,even-series/sym))
		    ,@body))
		(t `(progn
		      ,@body)))))))

(defun sum-double (s)
  (collect-sum (map-fn t #'sum-digits<100 s)))

(defun sum (s)
  (collect-sum s))

(defun split-sum-digits1 (ds)
  (with-odd/even-key-series (odds evens) ds 
      :double-evens
    (+ (sum evens)
       (sum odds))))

(defun split-sum-digits2 (ds)
  (with-odd/even-key-series (odds evens) ds
      :double-odds
    (+ (sum evens)
       (sum-double odds))))

(defun verify-check-digit (ds)
  (if (= (mod (split-sum-digits1 ds) 10) 0)
      'valid-check-digit
      'invalid-check-digit))

(defun generate-check-digit (ds)
  (let ((x (mod (split-sum-digits2 ds) 10)))
    (if (= x 0) 
	x
	(- 10 x))))