The Pragmatic Programmer: From Journeyman to Master was a quick and relatively fun read. The book covers many broad topics of everyday programming, such as project management, documentation, testing and automation. While reading I noticed that I already follow many of the principles outlined in the book, but reading it on paper helped encourage me to continue to do so.

Most of material new to me concerned project management and customer relationships. Two such items include having a project glossary and choosing appropriate ways to pleasantly surprise customers.

All programmers should know the book's material and practice it everyday. In my opinion, college's should require more reading of this type to help prepare students for the real world. Overall, it is a great book for professional programmers.

;;; SICP Section 3.1

;;; 3.1
(defun make-accumulator (n)
  (lambda (x)
    (incf n x)))

;;; 3.2
(defun make-monitored (f)
  (let ((count 0))
    (lambda (x)
      (cond ((eq x 'how-many-calls?) count)
     ((eq x 'reset-count) (setf count 0))
     (t (incf count)
        (funcall f x))))))

;;; 3.3 and 3.4 - updated for 3.7
(defun make-account (balance password)
  (let ((consecutive-attempts 0))
    (labels ((withdraw (amount)
        (if (>= balance amount)
     (setf balance (- balance amount))
     "Insufficient funds"))
      (deposit (amount)
        (setf balance (+ balance amount)))
      (dispatch (pass m)
        (cond
   ;; Incorrect password?
   ((not (eq pass password))
    (lambda (x)
      (if (<= 7 (incf consecutive-attempts))
   "Calling cops"
   "Incorrect password")))
   ;; Withdrawing?
   ((eq m 'withdraw)
    (setf consecutive-attempts 0)
    #'withdraw)
   ;; Depositing?
   ((eq m 'deposit)
    (setf consecutive-attempts 0)
    #'deposit)
   ;; Creating joint account?
   ((eq m 'joint)
    (lambda (new-pass)
      (lambda (pass m)
        (if (eq pass new-pass)
     (funcall #'dispatch password m)
     (funcall #'dispatch nil m)))))
   (t (error "Unknown request -- MAKE-ACCOUNT")))))
      #'dispatch)))

(defun withdraw (acc pwd amt)
  (funcall (funcall acc pwd 'withdraw) amt))

(defun deposit (acc pwd amt)
  (funcall (funcall acc pwd 'deposit) amt))

;;; 3.5
(defun random-in-range (low high)
  (let ((range (- high low)))
    (+ low (random range))))

(defun monte-carlo (trials experiment)
  (labels ((iter (trials-remaining trials-passed)
      (cond ((= trials-remaining 0)
      (float (/ trials-passed trials)))
     ((funcall experiment)
      (iter (- trials-remaining 1) (+ trials-passed 1)))
     (t
      (iter (- trials-remaining 1) trials-passed)))))
    (iter trials 0)))

(defun in-circle-p ()
  (let ((x (random-in-range 0 1.0))
 (y (random-in-range 0 1.0)))
    (<= (+ (expt (- x 0.5) 2)
    (expt (- y 0.5) 2))
 (expt 0.5 2))))

(defun estimate-integral (p x1 x2 y1 y2 trials)
  (let ((area-of-rect (* (- x2 x1)
    (- y2 y1)))
 (frac-inside (monte-carlo trials p)))
    (* frac-inside area-of-rect)))

;;; 3.6
(let ((st (make-random-state)))
  (defun rnd (sym)
    (cond ((eq sym 'generate)
    (lambda (x)
      (random x st)))
   ((eq sym 'reset)
    (lambda (x)
      (setf st x)))
   (t "Unknown symbol"))))

;;; 3.7
(defun make-joint (acc pass new-pass)
  (funcall (funcall acc pass 'joint) new-pass))

;;; 3.8
(let ((num 1))
  (defun f (n)
    (setf num (* num n))))

;;;; SICP Section 2.3

;;; 2.54
(defun my-equals (list1 list2)
  (cond ((and (null list1) (null list2)) t)
 ((and (consp (car list1)) (consp (car list2)))
  (and (my-equals (car list1) (car list2))
       (my-equals (cdr list1) (cdr list2))))
 (t (and (equalp (car list1) (car list2))
  (my-equals (cdr list1) (cdr list2))))))

;;; 2.55
;; ''abc => (quote (quote abc))
;; (car (quote (quote abc))) = > quote

;;; 2.56
;;; Differentiation definitions
(defun variablep (x)
  (symbolp x))

(defun same-variable-p (v1 v2)
  (and (variablep v1) (variablep v2) (equal v1 v2)))

(defun sump (x)
  (and (consp x) (equal (car x) '+)))

(defun addend (s)
  (cadr s))

(defun augend (s)
  (caddr s))

(defun productp (x)
  (and (consp x) (equal (car x) '*)))

(defun multiplier (p)
  (cadr p))

(defun multiplicand (p)
  (caddr p))

(defun =number (exp num)
  (and (numberp exp) (= exp num)))

(defun make-sum (a1 a2)
  (cond ((=number a1 0) a2)
 ((=number a2 0) a1)
 ((and (numberp a1) (numberp a2)) (+ a1 a2))
 (t (list '+ a1 a2))))

(defun make-product (m1 m2)
  (cond ((or (=number m1 0) (=number m2 0)) 0)
 ((=number m1 1) m2)
 ((=number m2 1) m1)
 ((and (numberp m1) (numberp m2)) (* m1 m2))
 (t (list '* m1 m2))))

;;; Exponent definitions
(defun exponentiationp (x)
  (and (consp x) (equal (car x) '^)))

(defun base (exp)
  (cadr exp))

(defun exponent (exp)
  (caddr exp))

(defun make-exponentiation (base exp)
  (cond ((=number exp 0) 1)
 ((=number exp 1) base)
 ((and (numberp base) (numberp exp)) (expt base exp))
 (t (list '^ base exp))))

(defun deriv (exp var)
  (cond ((numberp exp) 0)
 ((variablep exp)
  (if (same-variable-p exp var) 1 0))
 ((sump exp)
  (make-sum (deriv (addend exp) var)
     (deriv (augend exp) var)))
 ((productp exp)
  (make-sum
   (make-product (multiplier exp)
   (deriv (multiplicand exp) var))
   (make-product (deriv (multiplier exp) var)
   (multiplicand exp))))
 ((exponentiationp exp)
  (make-product
   (exponent exp)
   (make-product
    (make-exponentiation (base exp) (- (exponent exp) 1))
    (deriv (base exp) var))))
 (t "unknown expression type")))

;;; 2.57
(defun addend (s)
  (cadr s))

(defun augend (s)
  (let ((augend (cddr s)))
    (if (= 1 (length augend))
 (car augend)
 (make-sum (car augend) (cdr augend)))))

(defun multiplier (p)
  (cadr p))

(defun multiplicand (p)
  (let ((multiplicand (cddr p)))
    (if (= 1 (length multiplicand))
 (car multiplicand)
 (make-product (car multiplicand)
        (cdr multiplicand)))))

(defun make-sum (a1 a2)
  (cond ((=number a1 0) a2)
 ((=number a2 0) a1)
 ((and (numberp a1) (numberp a2)) (+ a1 a2))
 ((sump a2) (list '+ a1 (addend a2) (augend a2)))
 ((productp a2) (list '+ a1 (make-product
        (multiplier a2)
        (multiplicand a2))))
 ((and (consp a2) (> (length a2) 1))
  (list '+ a1 (make-sum (car a2) (cdr a2))))
 ((consp a2) (list '+ a1 (car a2)))
 (t (list '+ a1 a2))))

(defun make-product (m1 m2)
  (cond ((or (=number m1 0) (=number m2 0)) 0)
 ((=number m1 1) m2)
 ((=number m2 1) m1)
 ((and (numberp m1) (numberp m2)) (* m1 m2))
 ((productp m2) (list '* m1 (multiplier m2) (multiplicand m2)))
 ((sump m2) (list '* m1 (make-sum (addend m2) (augend m2))))
 ((and (consp m2) (> (length m2) 1))
  (list '* m1 (make-product (car m2) (cdr m2))))
 ((consp m2) (list '* m1 (car m2)))
 (t (list '* m1 m2))))

;;; 2.58
(defun sump (x)
  (and (consp x) (equal (cadr x) '+)))

(defun addend (s)
  (car s))

(defun augend (s)
  (caddr s))

(defun productp (x)
  (and (consp x) (equal (cadr x) '*)))

(defun multiplier (p)
  (car p))

(defun multiplicand (p)
  (caddr p))

(defun make-sum (a1 a2)
  (cond ((=number a1 0) a2)
 ((=number a2 0) a1)
 ((and (numberp a1) (numberp a2)) (+ a1 a2))
 (t (list a1 '+  a2))))

(defun make-product (m1 m2)
  (cond ((or (=number m1 0) (=number m2 0)) 0)
 ((=number m1 1) m2)
 ((=number m2 1) m1)
 ((and (numberp m1) (numberp m2)) (* m1 m2))
 (t (list m1 '* m2))))

;;; lookup b

;;; 2.59
(defun element-of-set-p (x set)
  (cond ((null set) nil)
 ((equal x (car set)) t)
 (t (element-of-set-p x (cdr set)))))

(defun adjoin-set (x set)
  (if (element-of-set-p x set)
      set
      (cons x set)))

(defun intersection-set (set1 set2)
  (cond ((or (null set1) (null set2)) nil)
 ((element-of-set-p (car set1) set2)
  (cons (car set1)
        (intersection-set (cdr set1) set2)))
 (t (intersection-set (cdr set1) set2))))

(defun union-set (set1 set2)
  (cond ((null set1) set2)
 ((null set2) set1)
 ((element-of-set-p (car set1) set2)
  (union-set (cdr set1) set2))
 (t (cons (car set1)
   (union-set (cdr set1) set2)))))

;;; 2.60
(defun adjoin-set-2 (x set)
  (cons x set))

(defun union-set-2 (set1 set2)
  (cond ((null set1) set2)
 ((null set2) set1)
 (t (cons (car set1)
   (union-set-2 (cdr set1) set2)))))

;;; 2.61
(defun adjoin-set-2 (x set)
  (let ((first (car set)))
    (cond ((null set) (list x))
   ((= x first) set)
   ((> x first) (cons first (adjoin-set-2 x (cdr set))))
   (t (cons x set)))))

;;; 2.62
(defun union-set-2 (set1 set2)
  (cond ((null set1) set2)
 ((null set2) set1)
 ((= (car set1) (car set2))
  (cons (car set1) (union-set-2 (cdr set1) (cdr set2))))
 ((> (car set1) (car set2))
  (cons (car set2) (union-set-2 set1 (cdr set2))))
 (t (cons (car set1) (union-set-2 (cdr set1) set2)))))

;;; 2.66
(defun lookup (given-key set-of-records)
  (let ((current-record (car set-of-records))
 (key (key current-record)))
    (cond ((null set-of-records) nil)
   ((= given-key key) current-record)
   ((> given-key key)
    (lookup given-key (right-tree set-of-records)))
   (t (lookup given-key (left-tree set-of-records))))))

;;; Huffman tree representation
(defun make-leaf (symbol weight)
  (list 'leaf symbol weight))

(defun leaf? (object)
  (equalp (car object) 'leaf))

(defun symbol-leaf (x) (cadr x))

(defun weight-leaf (x) (caddr x))

(defun make-code-tree (left right)
  (list left
 right
 (append (symbols left) (symbols right))
 (+ (weight left) (weight right))))

(defun left-branch (tree) (car tree))

(defun right-branch (tree) (cadr tree))

(defun symbols (tree)
  (if (leaf? tree)
      (list (symbol-leaf tree))
      (caddr tree)))

(defun weight (tree)
  (if (leaf? tree)
      (weight-leaf tree)
      (cadddr tree)))

(defun decode (bits tree)
  (defun decode-1 (bits current-branch)
    (if (null bits)
 nil
 (let ((next-branch
        (choose-branch (car bits) current-branch)))
   (if (leaf? next-branch)
       (cons (symbol-leaf next-branch)
      (decode-1 (cdr bits) tree))
       (decode-1 (cdr bits) next-branch)))))
  (decode-1 bits tree))

(defun choose-branch (bit branch)
  (cond ((= bit 0) (left-branch branch))
 ((= bit 1) (right-branch branch))
 (t (error "bad bit"))))

(defun adjoin-set (x set)
  (cond ((null set) (list x))
 ((< (weight x) (weight (car set))) (cons x set))
 (t (cons (car set) (adjoin-set x (cdr set))))))

(defun make-leaf-set (pairs)
  (if (null pairs)
      nil
      (let ((pair (car pairs)))
 (adjoin-set (make-leaf (car pair) (cadr pair))
      (make-leaf-set (cdr pairs))))))

;;; 2.67
(defparameter *sample-tree*
  (make-code-tree (make-leaf 'a 4)
    (make-code-tree
     (make-leaf 'b 2)
     (make-code-tree (make-leaf 'd 1)
       (make-leaf 'c 1)))))

(defparameter *sample-message* '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(decode *sample-message* *sample-tree*) ; => (A D A B B C A)

;;; 2.68
(defun encode (message tree)
  (if (null message)
      nil
      (append (encode-symbol (car message) tree)
       (encode (cdr message) tree))))

(defun encode-symbol (symbol tree)
  (cond ((or (null tree) (leaf? tree)) nil)
 ((member symbol (symbols (left-branch tree)))
  (cons 0 (encode-symbol symbol (left-branch tree))))
 ((member symbol (symbols (right-branch tree)))
  (cons 1 (encode-symbol symbol (right-branch tree))))
 (t (error "Symbol not in tree."))))

;;; 2.69
(defun generate-huffman-tree (pairs)
  (successive-merge (make-leaf-set pairs)))

(defun successive-merge (leaf-set &optional sub-tree)
  (cond ((null (cdr leaf-set))
  (make-code-tree (car leaf-set) sub-tree))
 ((null sub-tree)
  (successive-merge (cdr leaf-set) (car leaf-set)))
 (t (successive-merge (cdr leaf-set)
        (make-code-tree (car leaf-set)
          sub-tree)))))

;;; 2.70
(defparameter *lyric-huff-tree*
  (generate-huffman-tree '((a 2) (boom 1) (get 2) (job 2)
      (na 16) (sha 3) (yip 9) (wah 1))))

(defparameter *song* '(get a job sha na na na na na na na na
         get a job sha na na na na na na na
         wah yip yip yip yip yip yip yip yip
         yip Sha boom))

(length (encode *song* *lyric-huff-tree*)) ; => 86

;; 2.71
;; Most frequent = 1, least = N - 1

SICP Exercise 2.17

(defun last-pair (list)
  (if (null (cdr list))
      list
      (last-pair (cdr list))))

SICP Exercise 2.18

(defun rev (list)
  (if (null (cdr list))
      list
      (cons (car (last list))
        (rev (butlast list)))))

SICP Exercise 2.19

(defparameter *us-coins* (list 50 25 10 5 1))
(defparameter *uk-coins* (list 100 50 20 10 5 1 0.5))

(defun count-change (amount coin-values)
  (cc amount coin-values))

(defun cc (amount coin-values)
  (cond ((= amount 0) 1)
     ((or (< amount 0) (no-more-p coin-values)) 0)
     (t (+ (cc amount
           (except-first-denomination coin-values))
             (cc (- amount
               (first-denomination coin-values))
           coin-values)))))

(defun no-more-p (coin-values)
  (null coin-values))

(defun except-first-denomination (coin-values)
  (cdr coin-values))

(defun first-denomination (coin-values)
  (car coin-values))

SICP Exercise 2.20

(defun same-parity (integer &rest integers)
  (cond ((null integers) integer)
    ((evenp integer) (append (list integer)
                                 (remove-if-not #'evenp integers)))
    (t (append (list integer) (remove-if-not #'oddp integers)))))

SICP Exercise 2.21

defun square-list-1 (items)
  (if (null items)
      nil
      (cons (expt (car items) 2)
     (square-list-1 (cdr items)))))

(defun square-list-2 (items)
  (mapcar (lambda (x) (* x x))
   items))

SICP Exercise 2.23

(defun for-each (proc items)
  (when (consp items)
    (funcall proc (car items))
    (for-each proc (cdr items))))

SICP Exercise 2.27

(defparameter x (list (list 1 2) (list 3 4)))

(defun last-element (list)
  "Returns the last element of LIST."
  (car (last list)))

(defun deep-rev (list)
  (cond ((and (= 1 (length list)) (not (listp (car list)))) list)
 ((= 1 (length list)) (list (deep-rev (car list))))
 ((listp (last-element list))
  (cons (deep-rev (last-element list))
        (deep-rev (butlast list))))
 (t (cons (last-element list)
   (deep-rev (butlast list))))))

SICP Exercise 2.28

(defun fringe (list)
  (when list
    (if (atom list)
 (list list)
 (append (fringe (car list))
  (fringe (cdr list))))))

SICP Exercise 2.29

;; a.
(defun make-mobile (left right)
  (list left right))

(defun make-branch (length structure)
  (list length structure))

(defun left-branch (mobile)
  (first mobile))

(defun right-branch (mobile)
  (second mobile))

(defun branch-length (branch)
  (first branch))

(defun branch-structure (branch)
  (second branch))

;; b.
(defun mobilep (structure)
  (listp structure))

(defun total-weight (mobile)
  (+ (total-branch-weight (left-branch mobile))
     (total-branch-weight (right-branch mobile))))

(defun total-branch-weight (branch)
  (let ((branch-structure (branch-structure branch)))
    (if (mobilep branch-structure)
 (total-weight branch-structure)
 branch-structure)))

;;; c.
(defun torque (branch)
  (* (branch-length branch)
     (total-branch-weight branch)))

(defun balanced-mobile-p (mobile)
  (let ((left (left-branch mobile))
 (right (right-branch mobile)))
    (cond
      ;; Return false if the left and right torques are unequal.
      ((/= (torque left) (torque right)) nil)
      ;; The mobile is balanced at this level.  Return true if there
      ;; are no more submobiles.
      ((and (not (mobilep left))
     (not (mobilep right)))
       t)
      ;; Submobiles exist.  Check their balance.
      (t (and (if (mobilep (branch-structure left))
    (balanced-mobile-p (branch-structure left))
    t)
       (if (mobilep (branch-structure right))
    (balanced-mobile-p (branch-structure right))
    t))))))

;;; d. For section a, we need to replace the first and second
;;; functions with car and cdr respectively.  The remaining sections
;;; can be left intact.

SICP Exercise 2.30

(defun square-tree-1 (tree)
  (cond ((null tree) nil)
 ((not (listp tree)) (* tree tree))
 (t (cons (square-tree-1 (car tree))
   (square-tree-1 (cdr tree))))))

(defun square-tree-2 (tree)
  (mapcar (lambda (sub-tree)
     (if (listp sub-tree)
  (square-tree-2 sub-tree)
  (* sub-tree sub-tree)))
   tree))

SICP Exercise 2.31

(defun tree-map (proc tree)
  (mapcar (lambda (sub-tree)
     (if (listp sub-tree)
  (tree-map proc sub-tree)
  (funcall proc sub-tree)))
   tree))

(defun square (x)
  (* x x))

(defun square-tree-3 (tree)
  (tree-map #'square tree))

SICP Exercise 2.32

(defun subsets (s)
  (if (null s)
      (list nil)
      (let ((rest (subsets (cdr s))))
 (append rest (mapcar (lambda (x)
          (cons (car s) x))
        rest)))))

SICP Exercise 2.33

(defun accumulate (op initial sequence)
  (if (null sequence)
      initial
      (funcall op (car sequence)
        (accumulate op initial (cdr sequence)))))

(defun my-map (p sequence)
  (accumulate (lambda (x y)
  (cons (funcall p x) y))
       nil
       sequence))

(defun my-append (seq1 seq2)
  (accumulate #'cons seq2 seq1))

(defun my-length (sequence)
  (accumulate (lambda (x y)
  ;; Avoid style warnings by telling the compiler to
  ;; ignore X.
  (declare (ignore x))       
  (+ 1 y))
       0 sequence))

SICP Exercise 2.34

(defun horner-eval (x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
  (+ this-coeff
     (* x higher-terms)))
       0
       coefficient-sequence))

SICP Exercise 2.35

(defun count-leaves (tree)
  (accumulate #'+
       0
       (mapcar (lambda (sub-tree)
   (if (listp sub-tree)
       (count-leaves sub-tree)
       1))
        tree)))

SICP Exercise 2.36

(defun accumulate-n (op init seqs)
  (if (null (car seqs))
      nil
      (cons (accumulate op init (mapcar #'car seqs))
     (accumulate-n op init (mapcar #'cdr seqs)))))

SICP Exercise 2.37

(defun dot-product (v w)
  (accumulate #'+ 0 (mapcar #'* v w)))

(defun matrix-*-vector (m v)
  (mapcar (lambda (row)
     (dot-product row v))
   m))

(defun transpose (mat)
  (accumulate-n #'cons nil mat))

(defun matrix-*-matrix (m n)
  (let ((cols (transpose n)))
    (mapcar (lambda (row)
       (matrix-*-vector cols row))
     m)))

SICP Exercise 2.39

(defun fold-left (op initial sequence)
  (labels ((iter (result rest)
      (if (null rest)
   result
   (iter (funcall op result (car rest))
         (cdr rest)))))
    (iter initial sequence)))

(defun fold-right (op initial sequence)
  (accumulate op initial sequence))

(defun reverse-1 (sequence)
  (fold-right (lambda (x y)
  (append y (list x)))
       nil
       sequence))

(defun reverse-2 (sequence)
  (fold-left (lambda (x y)
        (append (list y) x))
      nil
      sequence))

SICP Exercise 2.40

(defun flatmap (proc seq)
  (accumulate #'append nil (mapcar proc seq)))

(defun enumerate-interval (x y)
  "Returns the list from X to Y"
  (loop for i from x to y collect i))

(defun unique-pairs (n)
  (flatmap 
   (lambda (i)
     (mapcar (lambda (j)
        (list i j))
      (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

;;; Definitions for prime?

(defun dividesp (a b) (zerop (mod b a)))

(defun find-divisor (n test-divisor)
  (cond ((> (square test-divisor) n) n)
 ((dividesp test-divisor n) test-divisor)
 (t (find-divisor n (+ test-divisor 1)))))

(defun smallest-divisor (n)
  (find-divisor n 2))

(defun prime? (n) (= n (smallest-divisor n)))

(defun prime-sum? (pair)
  (prime? (+ (car pair) (cadr pair))))

(defun make-pair-sum (pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(defun prime-sum-pairs (n)
  (mapcar #'make-pair-sum
   (remove-if-not #'prime-sum?
    (unique-pairs n))))

SICP Exercise 2.41

(defun triples (n s)
  (remove-if-not (lambda (list) (= s (reduce #'+ list)))
   (flatmap
    (lambda (i)
      (flatmap
       (lambda (j)
         (mapcar (lambda (k) (list i j k))
          (enumerate-interval 1 (- j 1))))
       (enumerate-interval 1 (- i 1))))
    (enumerate-interval 1 n))))

SICP Exercise 2.42

(defparameter empty-board nil)

(defun board-position (row col)
  "Represents a chess piece's position on the board."
  (list row col))

(defun adjoin-position (row col set-of-positions)
  "Adjoins a new row-column position to a set of positions."
  (append set-of-positions (list (board-position row col))))

(defun get-column (position)
  "Returns the column of the board-position POSITION."
  (cadr position))

(defun get-row (position)
  "Returns the row of the board position POSITION."
  (car position))

(defun get-board-position (col positions)
  "Returns the board position in column COL."
  (car (remove-if-not (lambda (position)
   (= col (get-column position)))
        positions)))

(defun in-same-row? (col positions)
  "Returns true if the queen in column COL shares the same row with
another queen in the position set POSITIONS."
  (let ((row (get-row (get-board-position col positions))))
    (some (lambda (position)
     (and (/= col (get-column position))
   (= row (get-row position))))
   positions)))

(defun in-diagonal? (col positions)
  "Returns true if the queen in column COL resides in the diagonal 
of another queen in the position set POSITIONS."
  (let ((row (get-row (get-board-position col positions))))
    (some (lambda (position)
     (when (/= col (get-column position))
       (= 1 (abs (/ (- row (get-row position))
      (- col (get-column position)))))))
   positions)))

(defun safe? (new-queen old-queens)
  "Returns true if the NEW-QUEEN does not reside in the same row
or diagonal of any of the OLD-QUEENS."
  (cond
    ;; Return true when no OLD-QUEENS exist.
    ((null old-queens) t)
    ;; Test if NEW-QUEEN resides on the same row.
    ((in-same-row? new-queen old-queens) nil)
    ;; Test if NEW-QUEEN resides on the same diagonal.
    ((in-diagonal? new-queen old-queens) nil)
    ;; Return true if all the tests pass.
    (t t)))

(defun queens (board-size)
  (labels ((queen-cols (k)
      (if (= k 0)
   (list empty-board)
   (remove-if-not
    (lambda (positions) (safe? k positions))
    (flatmap
     (lambda (rest-of-queens)
       (mapcar (lambda (new-row)
          (adjoin-position new-row
      k
      rest-of-queens))
        (enumerate-interval 1 board-size)))
     (queen-cols (- k 1)))))))
    (queen-cols board-size)))

SICP Exercise 2.44

(defun up-split (painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
 (below painter (beside smaller smaller)))))

SICP Exercise 2.45

(defun split (proc1 proc2)
  (labels ((do-split (painter n)
      (if (= n 0)
   painter
   (let ((smaller (do-split painter (- n 1))))
     (funcall proc1 painter
       (funcall proc2 smaller smaller))))))
    (lambda (painter n)
      (do-split painter n))))

SICP Exercise 2.46

(defun make-vect (x y)
  (cons x y))

(defun xcor-vect (v)
  (car v))

(defun ycor-vect (v)
  (cdr v))

(defun add-vect (v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
      (+ (ycor-vect v1) (ycor-vect v2))))

(defun sub-vect (v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
      (- (ycor-vect v2) (ycor-vect v2))))

(defun scale-vect (s v)
  (make-vect (* s (xcor-vect v))
      (* s (ycor-vect v))))

Using names.txt (right click and 'Save Link/Target As...'), a 46K text file containing over five-thousand first names, begin by sorting it into alphabetical order. Then working out the alphabetical value for each name, multiply this value by its alphabetical position in the list to obtain a name score.

For example, when the list is sorted into alphabetical order, COLIN, which is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN would obtain a score of 938 × 53 = 49714.

What is the total of all the name scores in the file?

This solution's final function follows the problem's definition precisely: sort the file, compute the alphabetical values for each name, then sum the values.

;;; Use the split-sequence library for splitting the names.txt file.
(require 'split-sequence)

(defparameter *ansi-base-code* 64
  "Subtract this value from a character's ansi integer value to get
the characters position in the alphabet.")

(defparameter *names-file* "programming/lisp/euler/names.txt"
  "The locations of names.txt on my computer.")

(defun char-position (char)
  "Returns CHAR's position in the alphabet.
Example: (char #\A) => 1
         (char #\C) => 3"
  (- (char-int char)
     *ansi-base-code*))

(defun alphabetical-value (string)
  "Returns the alphabetical value of STRING. For example, COLIN is worth
3 + 15 + 12 + 9 + 14 = 53"
  (reduce #'+ (map 'list (lambda (char)
                   (char-position char))
               string)))

(defun name-score (string position)
  "Returns the name score of STRING."
  (* (alphabetical-value string) position))

(defun name-scores (list)
  "Returns a list of the name scores of LIST. Removes any quotes from
the items in LIST before calculating the score."
  (let ((alphabetical-position 0))
    (mapcar (lambda (name)
                     (incf alphabetical-position)
                     (name-score (remove #\" name) alphabetical-position))
                 list)))

(defun parse-file (file delimiter)
  "Returns a list of items from FILE parsed by DELIMITER."
  (with-open-file (stream file)
    (split-sequence:split-sequence delimiter (read-line stream))))

(defun sort-list (list)
  "Sorts LIST by alphabetical string value."
  (sort list #'string<))

(defun sum-list (list)
  "Returns the sum of all the elements in LIST."
  (reduce #'+ list))

(defun euler-22 ()
  (sum-list (name-scores (sort-list (parse-file *names-file* #\,)))))

SICP Exercise 2.2
Consider the problem of representing line segments in a plane. Each segment is represented as a pair of points: a starting point and an ending point. Define a constructor make-segment and selectors start-segment and end-segment that define the representation of segments in terms of points. Furthermore, a point can be represented as a pair of numbers: the x coordinate and the y coordinate. Accordingly, specify a constructor make- point and selectors x-point and y-point that define this representation. Finally, using your selectors and constructors, define a procedure midpoint-segment that takes a line segment as argument and returns its midpoint (the point whose coordinates are the average of the coordinates of the endpoints). To try your procedures, you'll need a way to print points: (define
(print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))

;;; Utility functions
(defun average (x y)
  (/ (+ x y)
     2))

;;; Point and segment functions
(defun make-point (x y)
  (cons x y))

(defun x-point (point)
  (car point))

(defun y-point (point)
  (cdr point))

(defun make-segment (start end)
  (cons start end))

(defun start-segment (segment)
  (car segment))

(defun end-segment (segment)
  (cdr segment))

(defun midpoint-segment (segment)
  (make-point (average (x-point (start-segment segment))
                        (x-point (end-segment segment)))
       (average (y-point (start-segment segment))
               (y-point (end-segment segment)))))

(defun print-point (p)
  (format t "x=~D y=~D~%"
   (x-point p)
   (y-point p)))

SICP Exercise 2.3
Implement a representation for rectangles in a plane. (Hint: You may want to make use of exercise 2.2.) In terms of your constructors and selectors, create procedures that compute the perimeter and the area of a given rectangle. Now implement a different representation for rectangles. Can you design your system with suitable abstraction barriers, so that the same perimeter and area procedures will work using either representation?

(defun make-rec (lower-left-pt upper-right-pt)
  (cons lower-left-pt upper-right-pt))

(defun rec-upper-right (rec)
  (cdr rec))

(defun rec-lower-left (rec)
  (car rec))

(defun rec-upper-left (rec)
  (make-point (x-point (rec-lower-left rec))
               (y-point (rec-upper-right rec))))

(defun rec-lower-right (rec)
  (make-point (x-point (rec-upper-right rec))
               (y-point (rec-lower-left rec))))
 
(defun rec-len (rec)
  (- (y-point (rec-upper-left rec))
     (y-point (rec-lower-left rec))))

(defun rec-width (rec)
  (- (x-point (rec-lower-right rec))
     (x-point (rec-lower-left rec))))

(defun area-rec (rec)
  (* (rec-len rec)
      (rec-width rec)))

(defun perimeter-rec (rec)
  (* 2
     (+ (rec-len rec)
   (rec-width rec))))

;;; Alternative representation of rectangles

(defun alt-make-rec (bottom-seg left-seg)
  (cons bottom-seg left-seg))

(defun alt-upper-left (rec)
  (end-segment (cdr rec)))

(defun alt-lower-left (rec)
  (start-segment (car rec)))

(defun alt-lower-right (rec)
  (end-segment (cdr rec)))

(defun alt-upper-right (rec)
  (make-point (x-point (alt-lower-right rec))
               (y-point (alt-upper-left rec))))

SICP Exercise 2.4
Here is an alternative procedural representation of pairs. For this representation, verify that (car (cons x y)) yields x for any objects x and y.

(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))

What is the corresponding definition of cdr? (Hint: To verify that this works, make use of the substitution model of section 1.1.5.)

;;; Redefine Scheme functions in CL
(defun alt-cons (x y)
  (lambda (m) (funcall m x y)))

(defun alt-car (z)
  (funcall z (lambda (p q) p)))

(defun alt-cdr (z)
  (funcall z (lambda (p q) q)))

SICPSICP Exercise 2.5
Show that we can represent pairs of nonnegative integers using only numbers and arithmetic operations if we represent the pair a and b as the integer that is the product 2^a*3^b. Give the corresponding definitions of the procedures cons, car, and cdr.

(defun alt2-cons (a b)
  (* (expt 2 a) (expt 3 b)))

(defun alt2-car (z)
  (do ((i 0 (1+ i))
         (n z (/ n 2)))
      ((> (mod n 2) 0) i)))

(defun alt2-cdr (z)
  (do ((i 0 (1+ i))
         (n z (/ n 3)))
      ((> (mod n 3) 0) i)))

SICP Exercise 2.6
In case representing pairs as procedures wasn't mind-boggling enough, consider that, in a language that can manipulate procedures, we can get by without numbers (at least insofar as nonnegative integers are concerned) by implementing 0 and the operation of adding 1 as

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))

This representation is known as Church numerals, after its inventor, Alonzo Church, the logician who invented the calculus. Define one and two directly (not in terms of zero and add-1). (Hint: Use substitution to evaluate (add-1 zero)). Give a direct definition of the addition procedure + (not in terms of repeated application of add-1).

;;; Redefine Scheme functions in CL
(defun zero ()
  (lambda (f)
    (lambda (x) x)))

(defun add-1 (n)
  (lambda (f)
    (lambda (x)
      (funcall f (funcall (funcall n f) x)))))

;;; Definitions of one and two
(defun one ()
  (lambda (f)
    (lambda (x)
      (funcall f x))))

(defun two ()
  (lambda (f)
    (lambda (x)
      (funcall f (funcall f x)))))

;;; We can test our definitions of one and two with the following code:
;;; (funcall (funcall (one) #'1+) 0) => 1
;;; (funcall (funcall (two) #'1+) 0) => 2

;;; Notice the pattern for the definitions of one and two: the natural
;;; number N converts to its corresponding Church numeral by
;;; compositing the function f N times. We can abstract this by
;;; using a macro to define our Church numerals

(defun compose (times)
  (if (= times 1)
      '(funcall f x)
      `(funcall f ,(compose (1- times)))))

(defmacro def-church-numeral (name N)
  `(defun ,name ()
     (lambda (f)
       (lambda (x)
  ,(compose N)))))

;;; Now we can define new Church numerals as follows:
;;; (def-church-numeral three 3)
;;; (funcall (funcall (three) #'1+) 0) => 3

;;; To define an add function for Church numerals, implement the
;;; identity f(m + n)(x) = fm(fn(x)).  The code can look rather
;;; ugly in Common Lisp because the need for funcall, but to 
;;; understand it remember how we call the church numeral 
;;; functions, and see that the code calls the first church
;;; numeral and passes it to the second.

(defun add (m n)
  (lambda (f)
    (lambda (x)
      (funcall (funcall (funcall m) f)
           (funcall (funcall (funcall n) f) x)))))

;;; We can test the add function as follows:
;;;(funcall (funcall (add #'one #'three) #'1+) 0) => 4

SICP Exercise 2.7
Alyssa's program is incomplete because she has not specified the implementation of the interval abstraction. Here is a definition of the interval constructor:

(define (make-interval a b) (cons a b))

Define selectors upper-bound and lower-bound to complete the implementation.

;;; Redefine the Scheme functions in CL

(defun add-interval (x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
            (+ (upper-bound x) (upper-bound y))))

(defun mul-interval (x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
   (p2 (* (lower-bound x) (upper-bound y)))
   (p3 (* (upper-bound x) (lower-bound y)))
   (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
              (max p1 p2 p3 p4))))

(defun dev-interval (x y)
  (mul-interval x
        (make-interval (/ 1.0 (upper-bound y))
                         (/ 1.0 (lower-bound y)))))

(defun make-interval (a b)
  (cons a b))

;;; End of Scheme definitions

(defun upper-bound (interval)
  (max (car interval) (cdr interval)))

(defun lower-bound (interval)
  (min (car interval) (cdr interval)))

SICP Exercise 2.8
Using reasoning analogous to Alyssa's, describe how the difference of two intervals may be computed. Define a corresponding subtraction procedure, called sub-interval.

(defun sub-interval (x y)
  (add-interval x
        (make-interval (- (upper-bound y))
                         (- (lower-bound y)))))

SICP Exercise 2.9
The width of an interval is half of the difference between its upper and lower bounds. The width is a measure of the uncertainty of the number specified by the interval. For some arithmetic operations the width of the result of combining two intervals is a function only of the widths of the argument intervals, whereas for others the width of the combination is not a function of the widths of the argument intervals. Show that the width of the sum (or difference) of two intervals is a function only of the widths of the intervals being added (or subtracted). Give examples to show that this is not true for multiplication or division.

(defun interval-width (interval)
  (abs (/ (- (upper-bound interval) (lower-bound interval))
       2.0)))

SICP Exercise 2.11
In passing, Ben also cryptically comments: ‘‘By testing the signs of the endpoints of the intervals, it is possible to break mul-interval into nine cases, only one of which requires more than two multiplications.’’ Rewrite this procedure using Ben’s suggestion.

(defun sym-signum (n)
  "Calls signum and returns + or - instead of 1, -1, 0.  0 is
considered postive for the sake of this exercise"
  (let ((sign (signum n)))
    (cond ((eq sign 1) '+)
       ((eq sign -1) '-)
       ((eq sign 0) '+))))

(defun list-signs (lst)
  "Given a list of numbers, returns a list of the number's signs"
  (mapcar #'sym-signum lst))

(defmacro make-interval-if (signs &body body)
  "Cleans up the definition of new-mul-interval by removing lots
of repeated code"
  `(cond ,@(mapcar #'(lambda (statement)
         (let ((test-signs (first statement))
         (lower-bound (second statement))
         (upper-bound (third statement)))
    `((equal ,signs ',test-signs)
       (make-interval (* ,(first lower-bound)
                     ,(second lower-bound))
                 (* ,(first upper-bound)
                     ,(second upper-bound))))))
     body)))



(defun new-mul-interval (x y)
  (let* ((ux (upper-bound x))
     (lx (lower-bound x))
     (uy (upper-bound y))
     (ly (lower-bound y))
     (signs (list-signs (list lx ux ly uy)))
            ;; max and min are needed for the special case
     (max (max (* lx ly) (* lx uy) (* ux uy) (* ux ly)))
     (min (min (* lx ly) (* lx uy) (* ux uy) (* ux ly))))
    (make-interval-if signs
      ((+ + + +) (lx ly) (ux uy))
      ((+ + - +) (ux ly) (ux uy))
      ((+ + - -) (ux ly) (lx uy))
      ((- + + +) (uy lx) (uy ux))
      ((- + - -) (ux ly) (lx ly))
      ((- - + +) (lx uy) (ly ux))
      ((- - - +) (lx uy) (ly lx))
      ((- - - -) (ux uy) (ly lx))
      ;; special case:
      ((- + - +) (min 1) (max 1)))))

SICP Exercise 2.12
Define a constructor make-center-percent that takes a center and a percentage tolerance and produces the desired interval. You must also define a selector percent that produces the percentage tolerance for a given interval. The center selector is the same as the one shown above.

(defun make-center-percent (center percent)
  (let ((percent (/ percent 100.0)))
    (cons (- center (* center percent))
      (+ center (* center percent)))))

(defun center (interval)
  (/ (+ (lower-bound interval) (upper-bound interval)) 2))

(defun percent (interval)
  (let ((center (center interval))
   (lb (lower-bound interval)))
    (* (/ (- center lb)
   center)
       100)))

The sequence of triangle numbers is generated by adding the natural numbers. So the 7th triangle number would be
1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.
The first ten terms would be:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Let us list the factors of the first seven triangle numbers:

1: 1
3: 1,3
6: 1,2,3,6
10: 1,2,5,10
15: 1,3,5,15
21: 1,3,7,21
28: 1,2,4,7,14,28

We can see that 28 is the first triangle number to have over five divisors.

What is the value of the first triangle number to have over five hundred divisors?

(defun num-of-divisors (num)
  "Returns the number of divisors of num for num > 1"
  (let ((square-root (sqrt num))
          (result 0))
    (do ((x 1 (1+ x)))
           ((> x square-root) result)
      (when (zerop (mod num x))
             (setf result (+ 2 result))))))

(defun euler-12 (&optional (tri-num 1) (tri-val 1))
    (if (> (num-of-divisors tri-val) 500)
         tri-val
         (euler-12 (1+ tri-num) (+ 1 tri-num tri-val))))

Let d(n) be defined as the sum of proper divisors of n (numbers less than n which divide evenly into n).
If d(a) = b and d(b) = a, where a ≠ b, then a and b are an amicable pair and each of a and b are called amicable numbers.

For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 and 110 therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4, 71 and 142 so d(284) = 220.

Evaluate the sum of all the amicable numbers under 10000.

(defun divisor-p (num divisor)
  "Tests if divisor is a divisor of num"
  (zerop (mod num divisor)))

(defun divisors (num)
  "Returns a list of num's divisors"
  (do ((i 2 (1+ i))
         (result '(1)))
      ((> i (isqrt num)) (remove-duplicates result))
    (when (divisor-p num i)
      (setf result (append result (list i (/ num i)))))))

(defun sum-divisors (num)
  "Sums the divisors of num"
  (reduce #'+ (divisors num)))

(defun amicable-p (num)
  "Tests if num is amicable"
  (let ((divisors-sum (sum-divisors num)))
    (when (and (= num (sum-divisors divisors-sum)) 
                       (not (= num divisors-sum)))
      num)))

(defun amicable-sum (limit)
  "Returns the sum of all amicable numbers below limit"
  (do ((i 1 (1+ i))
         (result 0))
      ((>= i limit) result)
    (when (amicable-p i)
      (incf result i))))
  
(defun euler-21 ()
  (amicable-sum 10000))

n! means n × (n − 1) × ... × 3 × 2 × 1

Find the sum of the digits in the number 100!

(defun add-digits (num)
  "Returns the sum of the number's digits"
  (let ((sum 0)
         (num-string (write-to-string num)))
     (dotimes (i (length num-string))
       (setf sum (+ sum (digit-char-p (schar num-string i)))))
    sum))

(defun fact (num)
  (if (= num 1)
      1
      (* num (fact (1- num)))))

(defun euler-20 ()
  (add-digits (fact 100)))

You are given the following information, but you may prefer to do some research for yourself.

* 1 Jan 1900 was a Monday.
* Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

(defconstant +months+ '("Jan" "Feb" "Mar" "April" "May" "June"
   "July" "Aug" "Sept" "Oct" "Nov" "Dec"))

(defconstant +days+ '("Sun" "Mon" "Tue" "Wed" "Thurs" "Fri" "Sat"))

(defun days-in-month (month year)
  "Returns the number of days in the month given the month and year"
  (cond ((member month '("Sept" "April" "June" "Nov") :test #'string=)
             30)
            ((and (string= "Feb" month) (zerop (mod year 4))) 29)
            ((string= "Feb" month) 28)
            (t 31)))

(defun move-ahead (today days)
  "Moves ahead a number of days and returns the day.
Example: (move-ahead 'Mon' 3) => 'Thurs'
         (move-ahead 'Sun' 8) => 'Mon'"
  (let ((cur-day-num (position today +days+ :test #'string=)))
    (elt +days+ (mod (+ cur-day-num days) 7))))

(defun euler-19 ()
  (let ((today "Mon")
         (result 0))
    (loop for year from 1900 to 2000 do
       (dolist (month +months+)
          (when (and (string= today "Sun") (> year 1900))
              (incf result))
          (setf today (move-ahead today (days-in-month month year)))))
       result))

By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.

3
7 5
2 4 6
8 5 9 3

That is, 3 + 7 + 4 + 9 = 23.

Find the maximum total from top to bottom of the triangle below:

75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

NOTE: As there are only 16384 routes, it is possible to solve this problem by trying every route. However, Problem 67, is the same challenge with a triangle containing one-hundred rows it cannot be solved by brute force, and requires a clever method! ;o)

This problem is best solved by starting at the base and working up. Increment the number above each pair of nodes by the largest of the two nodes, and continue until you reach the top.

(defconstant +triangle+ 
  '(
    (75)
    (95 64)
    (17 47 82)
    (18 35 87 10)
    (20 04 82 47 65)
    (19 01 23 75 03 34)
    (88 02 77 73 07 63 67)
    (99 65 04 28 06 16 70 92)
    (41 41 26 56 83 40 80 70 33)
    (41 48 72 33 47 32 37 16 94 29)
    (53 71 44 65 25 43 91 52 97 51 14)
    (70 11 33 28 77 73 17 78 39 68 17 57)
    (91 71 52 38 17 14 91 43 58 50 27 29 48)
    (63 66 04 68 89 53 67 30 73 16 69 87 40 31)
    (04 62 98 27 23 09 70 98 73 93 38 53 60 04 23)))

(defun bottom-two-rows (triangle)
  "Returns the bottom two rows of a triangle"
  (list (car (last (butlast triangle)))
         (car (last triangle))))

(defun first-node-and-stems (triangle)
  "Given two rows of a triangle, returns the first node and the
first node's stems.
Example: (first-node-and-stems '((2 4 6) (8 5 9 3))) => 2 8 5"
  (let ((node (caar triangle))
          (left-stem (first (cadr triangle)))
          (right-stem (second (cadr triangle))))
    (values node left-stem right-stem)))

(defun max-node (node left-stem right-stem)
  (max (+ node left-stem)
           (+ node right-stem)))

(defun sum-stems (rows)
  "Given two adjacent rows of a triangle, returns a list of the
maximum total of the stems for each node.
Example: (sum-stems '((2 4 6) (8 5 9 3))) => (10 13 15)"
  (when (first rows)
    (multiple-value-bind (node left-stem right-stem)
        (first-node-and-stems rows)
      (cons (max-node node left-stem right-stem)
                (sum-stems (mapcar #'cdr rows))))))

(defun max-route (triangle)
  "Returns the sum of the route that produces the maximum total of
the given triangle"
  (if (= (length triangle) 2)
      (multiple-value-bind (node left-stem right-stem)
           (first-node-and-stems triangle)
        (max-node node left-stem right-stem))
      (max-route (append (butlast (butlast triangle))
                                      (list (sum-stems
                                             (bottom-two-rows triangle)))))))

(defun euler-18 ()
  (max-route +triangle+))

If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?
NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage.

(defun remove-hyphens (str)
  "Removes any hyphens from str"
  (remove #\- str))

(defun remove-spaces (str)
  "Removes any spaces from str"
  (remove #\Space str))

(defun euler-17 ()
  (+ (loop for i from 1 to 1000 sum
         (length (remove-hyphens (remove-spaces 
                                                       (format nil "~R" i)))))
     ;; SBCL does not include the word 'and', so add 
     ;; those letters also
     (* 3 99 9)))

2^(15) = 32768 and the sum of its digits is
3 + 2 + 7 + 6 + 8 = 26.
What is the sum of the digits of the number 2^(1000)?

(defun add-digits (num)
  "Returns the sum of the number's digits"
  (let ((sum 0)
          (num-string (write-to-string num)))
    (dotimes (i (length num-string))
      (setf sum (+ sum (digit-char-p (schar num-string i)))))
    sum))

(defun euler-16 ()
  (add-digits (expt 2 1000)))

Starting in the top left corner of a 2×2 grid, there are 6 routes (without backtracking) to the bottom right corner. How many routes are there through a 20×20 grid?

Since we can not backtrack, we can only move down and right. If we have a 2x2 grid, this means every route consists of exactly 2 right moves and 2 down moves. We can think of the routes as a set of moves, such as (d d r r), and the total number of routes will be all the different combinations of the set minus the identical combinations. To find the number of unique combinations, suppose we have the route (d d r r). Treating each move distinctly, lets write the set as (d1 d2 r1 r2). Notice how this route is equal to the route(d2 d1 r2 r1), and we only want to count this as one route. It turns out that the number of unique routes per combination is 2!*2! = 4: (d1 d2 r1 r2) (d1 d2 r2 r1) (d2 d1 r1 r2)(d2 d1 r2 r1). This means each route in the set of all possible route combinations, 4!, will have 3 other identical routes in the set, resulting in 4!/(2!2!) unique routes. This formula applies to larger grids as well.

(defun factorial (n &optional (acc 1))
  (if (<= n 1)
      acc
      (factorial (- n 1) (* acc n))))

(defun grid-routes (x-dim y-dim)
  "Calculates the number of routes from the top left corner
of a grid to the bottom right corner, without backtracking"
  (let ((total-number-of-moves (+ x-dim y-dim)))
    (/ (factorial total-number-of-moves)
       (* (factorial x-dim)
           (factorial y-dim)))))

(defun euler-15 ()
  (grid-routes 20 20))

The following iterative sequence is defined for the set of positive integers:
n → n/2 (n is even)
n → 3n + 1 (n is odd)
Using the rule above and starting with 13, we generate the following sequence:
13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.

Which starting number, under one million, produces the longest chain?

NOTE: Once the chain starts the terms are allowed to go above one million.

I listed two solutions to this problem in Common Lisp below. alt-euler-14 strictly follows the formula and computes the solution inefficiently. euler-14 stores computed values in a hash table so it never applies the formula to the same number more than once.

;;; *collatz-table* holds the number of terms for previously performed
;;; collatz calculations.  For example, say that we already found
;;; the number of terms to compute 10, which is 7.  If we compute
;;; the number of terms for 13, as in the example above, when it
;;; reaches 10 it will find this value in the table and add 7 to
;;; the current terms value to get the answer.
(defparameter *collatz-table* (make-hash-table))

(defun collatz (num)
  (cond ((= num 1) 1)
            ((gethash num *collatz-table*)
             (gethash num *collatz-table*))
            ((evenp num)
              (setf (gethash num *collatz-table*)
                      (1+ (collatz (/ num 2)))))
             (t (setf (gethash num *collatz-table*)
                         (1+ (collatz (1+ (* 3 num))))))))

(defun euler-14 ()
  (let ((answer 0)
          (max-terms 0))
    (do ((x 1 (1+ x)))
          ((>= x 1000000) answer)
      (let ((terms-of-x (collatz x)))
         (when (> terms-of-x max-terms)
           (setf max-terms terms-of-x
                   answer x))))))

(defun alt-collatz (num &optional (term 1))
  (cond ((= num 1) term)
            ((evenp num) (alt-collatz (/ num 2) (1+ term)))
            (t (alt-collatz (1+ (* 3 num)) (1+ term)))))

(defun alt-euler-14 ()
  (let ((answer 0)
         (max-terms 0))
    (do ((x 1 (1+ x)))
          ((>= x 1000000) answer)
      (let ((terms-of-x (alt-collatz x)))
        (when (> terms-of-x max-terms)
             (setf max-terms terms-of-x
                     answer x))))))

Alt-euler-14 took 8.5 seconds. euler-14's first run took 3 seconds, but the second run took 0.28 seconds. This speed came at a cost of more memory.

I'm currenlty working on a spring application that uses Spring Security to manage logins and page access on my site. After following the general process to set up Spring Security, as outlined in many online tutorials, you can retrieve the user information stored in the session as follows:

final SecurityContext sc = SecurityContextHolder.getContext();
final Authentication auth = sc.getAuthentication();
auth.getPrincipal();

In a typical security setup auth.getPrincipal will return a Spring Security user object which contains the current user's login name, password and roles. For my application, I wanted this object to also contain the user's unique id. This can be accomplished by extending two classes in a typical spring security setup.

In Spring Security, the authenticationDao is responsible for looking up the user's credentials. In my application the users are stored in a database, so at first I used JdbcDaoImpl for this. I wanted to return the user id as well, so this class needed some slight modifications. My new class extended JdbcDaoImpl and looks similar to this:

public class JdbcDaoUserIdImpl extends JdbcDaoImpl {

    /**
     * Injected by spring
     */
    private UserDao userDao;

    public void setUserDao(UserDao userDao) {
        this.userDao = userDao;
    }

    /**
     * Returns a UserDetails object that also contains the user's unique id
     * 
     * @see org.springframework.security.userdetails.jdbc.JdbcDaoImpl#createUserDetails(java.lang.String,
     *      org.springframework.security.userdetails.UserDetails,
     *      org.springframework.security.GrantedAuthority[])
     */
    protected UserDetails createUserDetails(String username,
            UserDetails userFromUserQuery,
            GrantedAuthority[] combinedAuthorities) {
        String returnUsername = userFromUserQuery.getUsername();

        if (!isUsernameBasedPrimaryKey()) {
            returnUsername = username;
        }

        User user = userDao.getUser(username);

        return new UserId(user.getId(), returnUsername, userFromUserQuery
                .getPassword(), userFromUserQuery.isEnabled(), true, true,
                true, combinedAuthorities);
    }

}

Notice that instead of returning a Spring Security User object it returns a UserId object. This class extends the User class and simply has one additional field containing, as you guessed, the user Id. It looks something like this:

public class UserId extends User {
    
    private static final long serialVersionUID = -8275492272371421013L;
    private long id;

    public UserId( long id, String username, String password, boolean enabled,
            boolean accountNonExpired, boolean credentialsNonExpired,
            boolean accountNonLocked, GrantedAuthority[] authorities)
            throws IllegalArgumentException {
        super(username, password, enabled, accountNonExpired, credentialsNonExpired,
                accountNonLocked, authorities);
        this.id = id;
    }
    
    /** 
     * Sets the user's unique id in the server's session object
     * @param id the user's id
     */
    public void setId(long id) {
        this.id = id;
    }

    /** 
     * 
     * @return the user's unique id
     */
    public long getId() {
        return this.id;
    }
    
    public String toString() {
        StringBuffer sb = new StringBuffer();
        sb.append(super.toString()).append(": ");
        sb.append("Id: ").append(this.id).append("; ");
        return sb.toString();
    }
    

}

After updating the security configuration files to use the new classes , we can store as many details as we like in each session. To get to the details, in your servlets cast the auth.getPrincipal object to your new class, in our case UserId.

Work out the first ten digits of the sum of the following one-hundred 50-digit numbers.

Common Lisp handles big numbers for you, so this problem is very easy.

(defparameter numbers '(
37107287533902102798797998220837590246510135740250
46376937677490009712648124896970078050417018260538
74324986199524741059474233309513058123726617309629
91942213363574161572522430563301811072406154908250
23067588207539346171171980310421047513778063246676
89261670696623633820136378418383684178734361726757
28112879812849979408065481931592621691275889832738
44274228917432520321923589422876796487670272189318
47451445736001306439091167216856844588711603153276
70386486105843025439939619828917593665686757934951
62176457141856560629502157223196586755079324193331
64906352462741904929101432445813822663347944758178
92575867718337217661963751590579239728245598838407
58203565325359399008402633568948830189458628227828
80181199384826282014278194139940567587151170094390
35398664372827112653829987240784473053190104293586
86515506006295864861532075273371959191420517255829
71693888707715466499115593487603532921714970056938
54370070576826684624621495650076471787294438377604
53282654108756828443191190634694037855217779295145
36123272525000296071075082563815656710885258350721
45876576172410976447339110607218265236877223636045
17423706905851860660448207621209813287860733969412
81142660418086830619328460811191061556940512689692
51934325451728388641918047049293215058642563049483
62467221648435076201727918039944693004732956340691
15732444386908125794514089057706229429197107928209
55037687525678773091862540744969844508330393682126
18336384825330154686196124348767681297534375946515
80386287592878490201521685554828717201219257766954
78182833757993103614740356856449095527097864797581
16726320100436897842553539920931837441497806860984
48403098129077791799088218795327364475675590848030
87086987551392711854517078544161852424320693150332
59959406895756536782107074926966537676326235447210
69793950679652694742597709739166693763042633987085
41052684708299085211399427365734116182760315001271
65378607361501080857009149939512557028198746004375
35829035317434717326932123578154982629742552737307
94953759765105305946966067683156574377167401875275
88902802571733229619176668713819931811048770190271
25267680276078003013678680992525463401061632866526
36270218540497705585629946580636237993140746255962
24074486908231174977792365466257246923322810917141
91430288197103288597806669760892938638285025333403
34413065578016127815921815005561868836468420090470
23053081172816430487623791969842487255036638784583
11487696932154902810424020138335124462181441773470
63783299490636259666498587618221225225512486764533
67720186971698544312419572409913959008952310058822
95548255300263520781532296796249481641953868218774
76085327132285723110424803456124867697064507995236
37774242535411291684276865538926205024910326572967
23701913275725675285653248258265463092207058596522
29798860272258331913126375147341994889534765745501
18495701454879288984856827726077713721403798879715
38298203783031473527721580348144513491373226651381
34829543829199918180278916522431027392251122869539
40957953066405232632538044100059654939159879593635
29746152185502371307642255121183693803580388584903
41698116222072977186158236678424689157993532961922
62467957194401269043877107275048102390895523597457
23189706772547915061505504953922979530901129967519
86188088225875314529584099251203829009407770775672
11306739708304724483816533873502340845647058077308
82959174767140363198008187129011875491310547126581
97623331044818386269515456334926366572897563400500
42846280183517070527831839425882145521227251250327
55121603546981200581762165212827652751691296897789
32238195734329339946437501907836945765883352399886
75506164965184775180738168837861091527357929701337
62177842752192623401942399639168044983993173312731
32924185707147349566916674687634660915035914677504
99518671430235219628894890102423325116913619626622
73267460800591547471830798392868535206946944540724
76841822524674417161514036427982273348055556214818
97142617910342598647204516893989422179826088076852
87783646182799346313767754307809363333018982642090
10848802521674670883215120185883543223812876952786
71329612474782464538636993009049310363619763878039
62184073572399794223406235393808339651327408011116
66627891981488087797941876876144230030984490851411
60661826293682836764744779239180335110989069790714
85786944089552990653640447425576083659976645795096
66024396409905389607120198219976047599490197230297
64913982680032973156037120041377903785566085089252
16730939319872750275468906903707539413042652315011
94809377245048795150954100921645863754710598436791
78639167021187492431995700641917969777599028300699
15368713711936614952811305876380278410754449733078
40789923115535562561142322423255033685442488917353
44889911501440648020369068063960672322193204149535
41503128880339536053299340368006977710650566631954
81234880673210146739058568557934581403627822703280
82616570773948327592232845941706525094512325230608
22918802058777319719839450180888072429661980811197
77158542502016545090413245809786882778948721859617
72107838435069186155435662884062257473692284509516
20849603980134001723930671666823555245252804609722
53503534226472524250874054075591789781264330331690 ))

(defun euler-13 ()
  (subseq (write-to-string (apply #'+ numbers))
              0 10))

What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 2020 grid?

This solution scans four rows at a time, saves the max adjacent product and scans the next four rows.

(defparameter *grid*
  '((08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08)
    (49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00)
    (81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65)
    (52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91)
    (22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80)
    (24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50)
    (32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70)
    (67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21)
    (24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72)
    (21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95)
    (78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92)
    (16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57)
    (86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58)
    (19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40)
    (04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66)
    (88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69)
    (04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36)
    (20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16)
    (20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54)
    (01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48)))

(defun max-r (grid)
  "Returns the maximum product of each rows elements"
  (apply #'max (mapcar #'(lambda (lst) (apply #'* lst))
                       grid)))

(defun max-c (grid)
  "Returns the maximum product of each columns elements"
  ;; Transpose the grid then call max-r
  (max-r (apply #'mapcar #'list grid)))

(defun diag-prod (grid &optional (accum 1))
  "Returns the product of the grids diagonal elements,
starting from the top left to the bottom right.
The function works recursively.  If there is a top-left
element in the grid, it multiplies accum by the element.
Then it calls itself with the top row and first column
of the grid removed"
  (if grid
      (diag-prod (mapcar #'cdr (cdr grid)) (* accum (caar grid)))
      accum))

(defun max-d (grid)
  "Returns the maximum product of each diagonals elements"
  (max (diag-prod grid)
           (diag-prod (mapcar #'reverse grid))))

(defun max-adj (grid)
  "Returns the maximum product of the grids adjacent elements.
Elements are multiplied in rows, columns, and diagonals"
  (max (max-r grid) (max-c grid) (max-d grid)))

(defun max-in-4byX (grid &optional (result 0))
  "Returns the maximum product of 4 adjacent elements in
a grid with 4 rows and a variable number of columns"
  (if (< (length (car grid)) 4)
      result
      (let* ((subgrid (mapcar #'(lambda (lst)
                                                  (subseq lst 0 4))
                                            grid))
                (max-in-subgrid (max-adj subgrid))
                (cur-result (cond ((< result max-in-subgrid) max-in-subgrid)
                                           (t result))))
          (max-in-4byX (mapcar #'cdr grid) cur-result))))

(defun euler-11 (grid &optional (result 0))
  "Calculates the max prod of 4 adjacent elements in the top 4 rows
of a grid, removes the top row and repeats.  Returns the maximum
product of 4 adjacent numbers in the entire grid"
  (if (< (length grid) 4)
      result
      (let* ((top-4-rows (subseq grid 0 4))
               (max-in-top-4 (max-in-4byX top-4-rows))
               (cur-result (cond ((< result max-in-top-4) max-in-top-4)
                                           (t result))))
        (euler-11 (cdr grid) cur-result))))

The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17. Find the sum of all the primes below two million.

This solution tests if a number is prime by testing if the number's smallest divisor is equal to itself. It then loops through all the odd numbers by two and sums the primes.

;;; Functions for testing if a number is prime
(defun square (x) (* x x))

(defun dividesp (a b)
  (zerop (mod b a)))

(defun find-divisor (n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((dividesp test-divisor n) test-divisor)
        (t (find-divisor n (+ test-divisor 1)))))

(defun smallest-divisor (n)
  (find-divisor n 2))

(defun primep (n)
  (= n (smallest-divisor n)))

;;; End of prime functions
  
(defun sum-of-primes-below (num)
  "Returns the sum of all the prime numbers below num"
  (+ 2 (loop for i from 3 to num by 2 when (primep i) sum i)))

(defun euler-10 ()
  (sum-of-primes-below 2000000))               

A Pythagorean triplet is a set of three natural numbers, a b c, for which a2 + b2 = c2.

For example, 32 + 42 = 9 + 16 = 25 = 52.

There exists exactly one Pythagorean triplet for which a + b + c = 1000. Find the product abc.

A brute-force solution in Common Lisp:

(defun sqrd (x)
  (* x x))

(defun pythag-trip-p (a b c)
  "Tests if a b and c satisfies the pythagorean equation"
  (eq (sqrd c)
        (+ (sqrd a) (sqrd b))))

(defun sum-eq-1000-p (a b c)
  "Tests if the sum equals 100"
  (= 1000 (+ a b c)))

(defun euler-9 ()
  (let ((result nil))
    (loop for a from 1 to 1000 until (not (null result)) do
     (loop for b from 1 to 1000 until (not (null result)) do
          (let ((c (sqrt (+ (sqrd a) (sqrd b)))))
             (when (sum-eq-1000-p a b c)
                   (print (list a b c))
                   (setf result (list a b c))))))
    (apply #'* result)))