Source code in the common programming language

;; make an infinite list whose accumulated sums give all
;; numbers n where n mod (base - 1) == n^2 mod (base - 1)
(defun res-list (base)
    (let* ((b (- base 1))
           (l (remove-if-not
		    (lambda (x) (= (rem x b) (rem (* x x) b)))
		    (loop for x from 0 below b collect x)))
	   (ret (append l (list b)))
	   (cycle (mapcar #'- (cdr ret) ret)))
	(setf (cdr (last cycle)) cycle)))
 
(defun kaprekar-p (n &optional (base 10))
   "tests if n is kaprekar in base; if so, return left and right half"
   (let ((nn (* n n)) (tens 1))
	; Find a start value for base power.  nn/tens + (nn mod tens) == n
	; can't be sastified if tens <= n: nn/tens = n * n / tens > n
	(loop while (< tens n) do
	      (setf tens (* tens base)))
	(if (= tens n)  ; n a power of base, can't be a solution except 1
	    (if (= n 1) (values T 0 1))
	    (loop
	       (let ((left (truncate nn tens)) (right (mod nn tens)))
		    (cond ((>= right n) (return nil))
			  ((= n (+ left right)) (return (values T left right))))
		    (setf tens (* base tens)))))))
 
(defun ktest (top &optional (base 10))
   (format t "   #    Value     Left    Right       Squared (base ~D)~%" base)
   (let ((fmt (format nil "~~4D ~~~D,8R ~~~D,8R ~~~D,8R ~~~D,13R~~%"
                      base base base base base))
	 (res (res-list base))
	 (n 0))
   	 (loop with cnt = 0 while (<= n top) do
	 	(setf n (+ n (car res)))
		(setf res (cdr res))
	 	(multiple-value-bind (k l r) (kaprekar-p n base)
		   (when k (format t fmt (incf cnt) n l r (* n n)))))))
 
(ktest 1000000)
(terpri)
(ktest 1000000 17)


;; Generate Kaprekar Numbers using Casting Out Nines Generator
;;
;; Nigel Galloway - October 1st., 2012
;;
(defconstant Base 10)
(defconstant MAX 1000000)
(defconstant ran (let ((N ()) (Base-1 (- Base 1))) (do ((cnt Base-1 (- cnt 1))) ((zerop cnt) (return N))
   (if (= (mod (* cnt (- cnt 1)) Base-1) 0) (setf N (cons cnt N))))))

(defun kap () (let ((Paddy_cnt 0) (Base-1 (- Base 1))) (do ((n 0 (+ n Base-1))) ((> n MAX) ()) (dolist (G ran)
   (let ((N (+ G n))) (if (>= MAX N) (let ((kk (* N N))) (do ((B Base (* B Base))) (nil)
     (let (( nr (/ (* N (- B N)) (- B 1)))) (if (< 0 nr) (let ((q (floor (- N nr)))) (if (= kk (+ nr (* q B)))
       (format t "~3d: ~8d is ~8d + ~8d and squared is ~8d~&" (incf Paddy_cnt) N q nr kk))
     (if (> B kk) (return)))))))))))))