Clojure Project Euler: Largest palindrome product

(apply max (for [x (range 100 1000)
                 y (range 100 1000)
                 :let [tmp (str (* x y))]
                 :when (= (seq tmp) (reverse tmp))]
             (Long/valueOf tmp)))
;; => 906609

defun make-palindrome (n &aux (m (write-to-string n)))
  (parse-integer (concatenate 'string m (reverse m))))
 
(defun largest-divisor (p m &aux (z (/ p m)))
  (when (> m 99) (if (and (integerp z) (< z 1000))
                     (list (list p m z))
                     (largest-divisor p (1- m)))))
 
(defun largest-palindrome-product (n m)
  (car (loop for a from n downto m
             nconc (largest-divisor (make-palindrome a) 999))))
 
> (largest-palindrome-product 998 800)
(906609 993 913)

(defun make-palindrome (n &aux (m (write-to-string n)))
  (parse-integer (concatenate 'string m (reverse m))))
 
(defun largest-divisor (p m &aux (z (/ p m)))
  (when (> m 99) (if (and (integerp z) (< z 1000))
                     (list p m z)
                     (largest-divisor p (1- m)))))
 
(defun largest-palindrome-product
    (n m &aux (z (largest-divisor (make-palindrome n) 999)))
  (when (> n m) (if z z (largest-palindrome-product (1- n) m))))
 
> (largest-palindrome-product 998 800)
(906609 993 913)

(defvar *low*  100)
(defvar *high* 999)
 
(defvar *iterations* 0)
 
(defun max-palindrome ()
  (multiple-value-bind (xy x y) (first-palindrome *high* *low*)
    (let ((x0 (1- x)))
      (loop (multiple-value-bind (ab a b) (first-palindrome x0 y)
              (cond ((> ab xy)
                     (setf xy ab x a y b)
                     (setf x0 (1- x)))
                    ((<= x0 y)
                     (return-from max-palindrome (values xy x y)))
                    (t
                     (decf x0))))))))
 
(defun first-palindrome (high low)
  (loop :for x :from high :downto low :do
        (loop :for y :from x :downto low :do
              (let ((xy (* x y)))
                (incf *iterations*)
                (when (palindromep xy)
                  (return-from first-palindrome (values xy x y))))))
  (values 0 0 0))
 
(defun palindromep (num)
  (let* ((str (write-to-string num))
         (len (length str))
         (max (1- len)))
    (dotimes (i (floor len 2))
      (unless (char= (char str i) (char str (- max i)))
        (return-from palindromep nil)))
    t))

(defun pal ()
  (labels ((test (x y) (> (car x) (car y))))
    (let (xys)
      (loop :for x :from *low* :to *high* :append
            (loop :for y :from *low* :to *high*
                  :do (incf *iterations*)
                  :when (palindromep (* x y))
                  :do (push (list (* x y) x y) xys)))
      (destructuring-bind (xy x y) (first (sort xys #'test))
        (values xy x y)))))
 
(defmacro stats ((fn &rest args))
  `(let ((*iterations* 0))
     (multiple-value-bind (xy x y) (time (,fn ,@args))
       (format t "; ~a result: ~a (~a * ~a)~%" ',fn xy x y)
       (format t "; iterations: ~a~%~%" *iterations*))))
 
(defun test ()
  (stats (pal))
  (stats (max-palindrome)))
 
(defun tests ()
  (let ((*low* 100) (*high* 999))
    (test))
  (let ((*low* 1000) (*high* 9999))
    (test)))

(tests)
Timing the evaluation of (PAL)
 
User time    =        1.294
System time  =        0.000
Elapsed time =        1.291
Allocation   = 16363112 bytes
0 Page faults
; PAL result: 906609 (993 * 913)
; iterations: 810000
 
Timing the evaluation of (MAX-PALINDROME)
 
User time    =        0.062
System time  =        0.000
Elapsed time =        0.065
Allocation   = 825172 bytes
0 Page faults
; MAX-PALINDROME result: 906609 (993 * 913)
; iterations: 41039
 
Timing the evaluation of (PAL)
 
User time    =  0:02:14.223
System time  =        0.015
Elapsed time =  0:02:14.215
Allocation   = 1945473240 bytes
0 Page faults
; PAL result: 99000099 (9999 * 9901)
; iterations: 81000000
 
Timing the evaluation of (MAX-PALINDROME)
 
User time    =        0.265
System time  =        0.000
Elapsed time =        0.268
Allocation   = 3886740 bytes
0 Page faults
; MAX-PALINDROME result: 99000099 (9999 * 9901)
; iterations: 161799

(defun make-palindrome (n &aux (m (write-to-string n)))
  (parse-integer (concatenate 'string m (reverse m))))
 
(defun largest-divisor (p m &aux (z (/ p m)))
  (when (>= m *low*)
    (if (and (integerp z) (< z *high*))
        (list p m z)
        (largest-divisor p (1- m)))))
 
(defun largest-palindrome-product
    (n m &aux (z (largest-divisor (make-palindrome n) *high*)))
  (when (> n m)
    (if z
        z
        (progn
          (incf *iterations*)
          (largest-palindrome-product (1- n) m)))))
 
(defun largest-palindrome ()
  (destructuring-bind (xy x y) (largest-palindrome-product *high* *low*)
    (values xy x y)))
 
(defun test ()
  ;(stats (pal))
  (stats (max-palindrome))
  (stats (largest-palindrome)))
 
(defun tests ()
  (let ((*low* 10000) (*high* 99999))
    (test)))

(tests)
Timing the evaluation of (MAX-PALINDROME)
 
User time    =       13.572
System time  =        0.000
Elapsed time =       13.564
Allocation   = 303 228 652 bytes
0 Page faults
; MAX-PALINDROME result: 9966006699 (99979 * 99681)
; iterations: 5416431
 
Timing the evaluation of (LARGEST-PALINDROME)
 
User time    =       12.214
System time  =        0.015
Elapsed time =       12.280
Allocation   = 825 990 504 bytes
0 Page faults
; LARGEST-PALINDROME result: 9966006699 (99979 * 99681)
; iterations: 339

(defun lp2 ()
  (loop :for n :from *high* :downto *low* :do
        (let ((p (make-palindrome n)))
          (multiple-value-bind (x y) (find-divisors p)
            (when x
              (return-from lp2 (values p x y))))))
  (values 0 0 0))
 
(defun find-divisors (n)
  (loop :for x :from *low* :to (min (ceiling (sqrt n)) *high*) :do
        (incf *iterations*)
        (multiple-value-bind (y rem) (floor n x)
          (when (and (<= *low* y *high*) (= rem 0))
            (return-from find-divisors (values x y)))))
  (values nil nil))

(tests)
Timing the evaluation of (MAX-PALINDROME)
 
User time    =       13.650
System time  =        0.000
Elapsed time =       13.670
Allocation   = 303 202 460 bytes
0 Page faults
; MAX-PALINDROME result: 9966006699 (99979 * 99681)
; iterations: 5 416 431
 
Timing the evaluation of (LARGEST-PALINDROME)
 
User time    =       12.729
System time  =        0.015
Elapsed time =       12.755
Allocation   = 825 919 808 bytes
0 Page faults
; LARGEST-PALINDROME result: 9966006699 (99979 * 99681)
; iterations: 30 510 360
 
Timing the evaluation of (LP2)
 
User time    =        6.723
System time  =        0.000
Elapsed time =        6.719
Allocation   = 137 268 bytes
0 Page faults
; LP2 result: 9966006699 (99681 * 99979)
; iterations: 30 571 435

(defun is-pal (n)
  (let ((s (fix2str n))) (eq s (strRev s))))
 
(defun task ()
 (let ((s nil) (p 0))
  (iter (for i from 999 to 900 by -1)
    (iter (for j from 999 to 900 by -1)
      (setq p (* i j))
      (when (is-Pal p) (setq s (list i j)) (return t)))
    (when s (return (cons p s))))))
 
 
==> task
 
(task)
 
==> (906609 993 913)

;; rakcket-lang.org
(define (palindrome? n)
  (let ((num (string->list (number->string n))))
    (equal? num (reverse num))))
 
(define (divisiors n max-arity)
  (let loop ((m (sub1 (expt 10 max-arity)))
             (minimum-number (expt 10 (sub1 max-arity))))
    (let ((temp-value (/ n m)))
      (cond [(integer? temp-value) (list m temp-value)]
            [(< m minimum-number) null]
            [else (loop (sub1 m) minimum-number)]))))
 
(define (log10 n) (/ (log n) (log 10)))
 
(define (extract-first-and-last n)
  (list (inexact->exact 
         (floor
          (exact->inexact 
           (/ n 
              (expt 10 (sub1 (inexact->exact (round (log10 n)))))))))
        (remainder n 10)))
 
(define (next-palindrome n)
  (let ((first-and-last (extract-first-and-last n)))
    (let loop ((m n) (first (car first-and-last)) (last (cadr first-and-last)))
      (if (palindrome? m)
          m
          (let* ((k (- m (- (if (<= last first) (+ 10 last) last) first)))
                 (first-and-last (extract-first-and-last k)))
            (loop k (car first-and-last) (cadr first-and-last)))))))
 
(define (main n)
  (let* ((max-arity n)
         (max-num (sub1 (expt 10 max-arity)))
         (palindrome (next-palindrome (* max-num max-num))))
    (let loop ((pal palindrome) (div (divisiors palindrome max-arity)))
      (cond [(< pal max-num) "not found!"]
            [(or (null? div) (ormap (curryr > max-num) div))
             (let ((tmp (next-palindrome (sub1 pal))))
               (loop tmp (divisiors tmp max-arity)))]
            [else (cons pal div)]))))
 
> (time (main 3))
cpu time: 17 real time: 17 gc time: 0
'(906609 993 913)
> (time (main 4))
cpu time: 231 real time: 232 gc time: 21
'(99000099 9999 9901)
> (time (main 5))
cpu time: 8753 real time: 8766 gc time: 506
'(9966006699 99979 99681)
>

Timing the evaluation of (LP2)
 
User time    =  0:03:29.805
System time  =        0.000
Elapsed time =  0:03:29.838
Allocation   = 4 355 815 628 bytes
0 Page faults
; LP2 result: 999000000999 (999001 * 999999)
; iterations: 899 750 896

> (map (λ (i) (time (main i))) '(3 4 5 6))
cpu time: 17 real time: 17 gc time: 0
cpu time: 1062 real time: 1066 gc time: 830
cpu time: 8669 real time: 8700 gc time: 452
cpu time: 287925 real time: 288501 gc time: 17565
'((906609 993 913) (99000099 9999 9901) (9966006699 99979 99681) (999000000999 999999 999001))
>