4.scm

   1 (require (only (lib "list.ss") sort))\r
   2 \r
   3 (define (numbers a b)\r
   4   (cond ((> a b) null)\r
   5         (else (cons a (numbers (add1 a) b)))))\r
   6 \r
   7 (define (cross l1 l2)\r
   8   (if (null? l1)\r
   9       '()\r
  10       (append (map (lambda (x)\r
  11                      (cons (car l1) x))\r
  12                    l2)\r
  13               (cross (cdr l1) l2))))\r
  14 \r
  15 (define 3-digit-numbers (numbers 111 999))\r
  16 \r
  17 (define sorted-pairs (reverse (sort (cross 3-digit-numbers\r
  18                                            3-digit-numbers)\r
  19                                     (lambda (x y)\r
  20                                       (< (* (car x) (cdr x))\r
  21                                          (* (car y) (cdr y)))))))\r
  22 \r
  23 (define (palindrome? s)\r
  24   (equal? s\r
  25           (list->string (reverse (string->list s)))))\r
  26 \r
  27 (let loop ((pairs sorted-pairs))\r
  28   (if (null? pairs)\r
  29       #f\r
  30       (let* ((pair (car pairs))\r
  31              (num  (number->string (* (caar pairs)\r
  32                                       (cdar pairs)))))\r
  33         (if (palindrome? num)\r
  34             num\r
  35             (loop (cdr pairs))))))\r
  36 \r