↻ /prog/ Challenge [Vol. λfx.f x] ↻

THE CHALLENGE: Write a program that, given a number n, prints the expansion of (a+b)^n.

Example: 4 → a^4 + 4a^3b + 6a^2b^2 + 4ab^3 + b^4

HOWEVER: You must do the above in a language you do not have any experience with. Never programmed in Haskell before? Gather some documentation and go for it.

_{(Well, you're advised to do that. I can't possibly know whether or not you know a programming language.)}

I've cheated since I wrote it in a langauge that I know, but here I go:

;;; Generic Utils (taken from other code I've written)

(defun ensure-length (sequence n &key (filler nil))
  (if (< (length sequence) n)
      (replace (make-sequence (class-of sequence) n :initial-element filler)
               sequence)
      sequence))

(defun take (sequence n &key (filler nil))  
  (subseq (ensure-length sequence n :filler filler) 0 n))

;; maybe this would be better done as a defun-memoized?
(defmacro memoize-named-function (name)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (fdefinition ',name) (memoize #',name))))

(defun memoize (function)
  (let ((values (make-hash-table :test #'equal)))
    #'(lambda (&rest args)
        (multiple-value-bind (value present-p)
            (gethash args values)
          (if present-p value
              (setf (gethash args values) (apply function args)))))))

(defun mappend (fn list
                &rest otherlists
                &aux (list (copy-list list)) (otherlists (copy-list otherlists)))         
  (apply #'mapcan fn list otherlists))

(defun insert-inbetween (list element &key (no-last t))
  (let ((new-list
         (mappend #'(lambda (e) (list e element)) list)))
    (if no-last (butlast new-list) new-list)))

(defun merge-strings (&rest strings)
  (apply #'concatenate 'string strings))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun symbolicate (syms &optional (package *package*))
    (intern (apply #'concatenate 'string (mapcar #'string syms)) package))
  (defun reverse-if (list reverse)
    (if reverse (reverse list) list)))

(defmacro with-gensyms (names &body body)
  `(let ,(loop for name in names collect `(,name (gensym ,(string name))))
     ,@body))


;;; Actual implementation of the challenge

(defun binomial-coefficients (n)  
  (unless (zerop n)
    `(1 ,@(maplist #'(lambda (list)                      
                       (apply #'+ (take list 2 :filler 0)))
                   (binomial-coefficients (1- n))))))

(memoize-named-function binomial-coefficients)

(macrolet ((frob-fun (name format reverse)
             (with-gensyms (string n)
               `(defun ,name (,string ,n)
                  (case ,n
                    (0 "")
                    (1 ,string)
                    (t (format nil ,format
                               ,@(reverse-if `(,string ,n) reverse))))))))
  (frob-fun string-to-the-power "~A^~D" nil)
  (frob-fun string-multiply "~A~D" t))

(defun binomial-element (n k)
  (merge-strings
   (string-to-the-power "a" (- n k))
   (string-to-the-power "b" k)))

(defun newton-binomial-expansion (n)
  (apply #'merge-strings
         (insert-inbetween
          (loop for k to n
                for element = (binomial-element n k)
                for coeff in (binomial-coefficients (1+ n))
                collect (string-multiply element coeff))
          " + ")))

;;; Test
CL-USER> (newton-binomial-expansion 1)
"a + b"
CL-USER> (newton-binomial-expansion 2)
"a^2 + 2ab + b^2"
CL-USER> (newton-binomial-expansion 3)
"a^3 + 3a^2b + 3ab^2 + b^3"
CL-USER> (newton-binomial-expansion 4)
"a^4 + 4a^3b + 6a^2b^2 + 4ab^3 + b^4"
CL-USER> (newton-binomial-expansion 5)
"a^5 + 5a^4b + 10a^3b^2 + 10a^2b^3 + 5ab^4 + b^5"