Common Lisp

I will post my implementation in a couple days. May the best EXPERT PROGRAMMER win

Write the function
simplify (x)
returns an expression in which constants have been combined and unnecessary operators have been
removed. x is a valid arithmetic LISP expression involving only the operators "+" and "*". Examples:
Expression Returns
(simplify ’a) a
(simplify ’(*)) 1
(simplify ’(+ a)) a
(simplify ’(* 1 a 1 1 1)) a
(simplify ’(* 8 7)) 56
(simplify ’(* 3 0 4)) 0
(simplify ’(+ a 1 2 b)) (+ 3 a b)
(simplify ’(* 4 (+ 2 3) (+ 1 2 3) (* 2 3))) 720
(simplify ’(+ 4 (+ 2 3 b) (+ 1 2 c 3) (* 2 3))) (+ 10 (+ 5 b) (+ 6 c))
(simplify ’(* 4 (+ 2 3 b) (+ 1 2 c 3) (* 2 3))) (* 24 (+ 5 b) (+ 6 c))
Note how constants are combined or eliminated whenever possible, and how the simplifications apply
recursively. Also note that adjacent unsimplifiable expressions are not combined; e.g., in the second to
last expression, the "+" operators are not combined to
(+ 21 b c)
That form of simplification is beyond this program. See the correct output for more examples.
Part 4:

Oooh, coding contest. GAME ON MOTHERFUCKERS

Easy stuff.  The last time I did a program like this I refused to skimp on simplification, derivation, or integration.
Do you know how hellish it is to integrate this shit?

I wanted to write this in Haskell but then I realized it isn't homoiconic :(
Does some variant of Lisp have pattern matching?

Easy as an eval/apply (and some typep).

>>4
Perhaps Qi^[1] is what you are looking for.

<sub>--
1. http://en.wikipedia.org/wiki/Qi_%28programming_language%29</sub>

>>1
Are we assuming that the input is well formed or do we perform some form of error handling e.g. choke_and_die()

>>7
Are you seriously suggesting that we should consider a lisp programmer making a mistake?

>>8
Well, I apparently made one right now

(define (simplify x)
  (if (pair? x)
      (do ((n '()) (r '()) (l (map simplify (cdr x)) (cdr l)))
        ((null? l)
         (let* ((r (reverse r))
                (p (eq? (car x) '*))
                (n (apply (if p * +) n))
                (u (= (length r) 1)))
           (if (null? r) n
           (if (= n 0) (if p 0 (if u (car r) (cons '+ r)))
           (if (and p (= n 1)) (if u (car r) (cons '* r))
               (cons (car x) (cons n r)))))))
        (if (number? (car l))
            (set! n (cons (car l) n))
            (set! r (cons (car l) r))))
      x))

55 paren pairs, but 2 don't really count because they're quoted. (37 with partition from SRFI 1 and receive from SRFI 8)

>>6
Yes, CL and Scheme are obviously too inflexible to add a pattern matcher.

>>10
I wasn't implying that they were too inflexible, but I had presumed he wanted pattern matching built-in and not as a library.

OP Here, forgot to mention the stuff to the right of the calls is sample output.
Also

NO ITERATION, NO DESTRUCTIVE CALLS
SOLUTION MUST BE RECURSIVE OR USE FUNCTION MAPPING

>>10
My god, what an ugly language!
Here's my CL-NOOB implomontation.

(defun simplify (l)
  (if (consp l)
      (let* ((o (car l))
             (a (mapcar #'simplify (cdr l)))
             (m (remove-if-not #'numberp a))
             (s (remove-if #'numberp a))
             (n (apply o m)))
        (cond ((null s) n)
              ((not (or (and (eq o '+) (= n 0))
                        (and (eq o '*) (= n 1))))
               (list* o n s))
              ((cdr s)
               (list* o s))
              (t (car s))))
      l))

;; it's been so long since I got to do someone's homework

>>12
Oh, fuck yoy!!! I'm posting this shit anyway. Next time state all requirements from the start, fucko.

(defun simplify (expr)
   (if (atom expr)
       expr
       (loop for i in (cdr expr)
             for si = (simplify i)
             when (numberp si)       collect si into numbers
             when (not (numberp si)) collect si into not-numbers
             finally
                (return (let ((result (apply (car expr) numbers)))
                             (if (null not-numbers)
                                 result
                                 (cons (car expr) (cons result not-numbers))))))))

s/yoy/you/

Since no-one has posted a PIG DISGUSTING solution yet, I shall post one

(require srfi/1)

(define (simplify exp)
  (if (pair? exp)
      (let* ((operator-symbol (car exp))
             (operator (eval operator-symbol))
             (args (cdr exp))
             (simplified-args (map simplify args)))
        (case (length simplified-args)
          ((0) (apply operator '()))
          ((1) (car simplified-args))
          (else
           (let-values (((numbers others) (partition number? (map simplify simplified-args))))
             (cond ((= (length numbers) 0)
                    (cons operator-symbol others))
                   ((= (length others) 0)
                    (apply operator numbers))
                   (else
                    (let ((total (apply operator numbers)))
                      (cond ((= total 0)
                             (if (eq? operator-symbol '+)
                                 (if (= (length others) 1)
                                     others
                                     (cons operator-symbol others))
                                 0))
                            ((and (= total 1) (eq? operator-symbol '*))
                             (if (= (length others) 1)
                                 (car others)
                                 (cons operator-symbol others)))
                            (else
                             (cons operator-symbol
                                   (cons total others)))))))))))
          exp))

If you read that and your eyes didn't bleed I feel sorry for you

Shit was wrong, so here's the corrected version.

(defun simplify (expr)
   (if (atom expr)
       expr
       (loop for i in (cdr expr)
             for si = (simplify i)
             when (numberp si)       collect si into numbers
             when (not (numberp si)) collect si into not-numbers
             finally
                (return (let ((result (apply (car expr) numbers)))
                             (cond ((null not-numbers)                            result)
                                   ((or (equalp (list (car expr) result) '(+ 0))
                                        (equalp (list (car expr) result) '(* 1))) (if (null (cdr not-numbers))
                                                                                      (car not-numbers)
                                                                                      (cons (car expr) not-numbers)))
                                   (                                              (cons (car expr) (cons result not-numbers)))))))))

>>16
(if (= (length others) 1)
                                     others
                                     (cons operator-symbol others))
That should be (car others), and the two conds could be simplified into one

Here's a more ENTERPRISE aproach to it:

;;; or just make an asdf proj for this
(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:oos 'asdf:load-op '#:arnesi))

(defpackage simplify
  (:use #:cl #:arnesi)
  (:import-from #:arnesi #:switch #:singlep #:with-collectors))

(in-package :simplify)

(defun simplify (e)
  (if (consp e)
      (destructuring-bind (op . args) e
        (let ((args (mapcar #'simplify args)))
          (multiple-value-bind (result symbols)
              (with-collectors (numbers symbols)
                (dolist (arg args (values (apply op (numbers)) (symbols)))
                  (funcall (if (numberp arg) #'numbers #'symbols) arg)))             
            (if symbols                                                           
                (switch ((list op result) :test #'equal)             
                  (((* 1) (+ 0)) (if (singlep symbols)
                                     (first symbols)
                                     (list* op symbols)))
                  (((* 0)) 0)
                  (t (list* op result symbols)))
                result))))
      e))r

Ignore that last r, copy pasting typo.

i.e. "value" out of Felleisen's book.