Subversion Repositories programming

;Written By: Ira Snyder
;Due Date:   02-11-2005
;Homework #: hw07
;License: Public Domain

;;; The next two functions define a special insertion sort
;;; that will sort a Polynomial-Normal-Form list
(defun ISORT (L)
  (cond
    ((null L) nil)
    (t        (ISORT1 (car L) (ISORT (cdr L))))
  )
)

;;; Helper for ISORT
(defun ISORT1 (N L)
  (cond
    ((null L)       (list N))
    ((>= (cadr N) (cadar L)) (cons N L))
    (t              (cons (car L) (ISORT1 N (cdr L))))
  )
)

;;; Combines the coefficients of a two part list, L1, 
;;; and a list comprised of two part lists, L2
;;; Example: L1 <- (1 1)
;;;          L2 <- ((2 2) (3 3) (4 4) (1 1))
;;; Returns: (2 1)
;;;
;;; It is good for combining the parts of a PNF expression
(defun COMBINE (L1 L2)
  (cond
    ((null L2)                L1)
    ((= (cadr L1) (cadar L2)) (COMBINE (list (+ (car L1) (caar L2)) (cadr L1))
                                       (cdr L2)))
    (t                        (COMBINE L1 (cdr L2)))
  )
)

;;; Deletes any two part list contained within the
;;; list L with the exponent given as an argument
;;; Example: EXP <- 1
;;;          L <- ((1 2) (1 1) (3 1) (1 4))
;;; Returns: ((1 2) (1 4))
(defun DEL-EXP (EXP L)
  (cond
    ((null L)          nil)
    ((= EXP (cadar L)) (DEL-EXP EXP (cdr L))) ;remove an element
    (t                 (cons (car L) (DEL-EXP EXP (cdr L))))
  )
)

;;; Combines all like terms in a PNF expression, reducing it
;;; completely. It does NOT sort the resulting list however.
(defun MY-REDUCE (L)
  (cond
    ((null L) nil)
    (t        (cons (COMBINE (car L) (cdr L)) 
                    (MY-REDUCE (DEL-EXP (cadr (COMBINE (car L) (cdr L))) L))))
  )
)

(defun DEL-ZERO (L)
  (cond
    ((null L) nil)
    ((= 0 (caar L)) (DEL-ZERO (cdr L)))
    (t              (cons (car L) (DEL-ZERO (cdr L))))
  )
)

;;; This takes a non-reduced, unsorted list representing a
;;; PNF expression, and reduces and sorts it into correct
;;; Polynomial-Normal-Form.
(defun PNF (L) (ISORT (DEL-ZERO (MY-REDUCE L))))