Subversion Repositories programming

;Written By: Ira Snyder
;Date:       01-20-2005
;Homework #: 03
;License: Public Domain

;;;
;;; Finds the discriminant of the quadratic
;;; function with the coefficients A B C
;;;
;;; Given by the value "underneath the root"
;;; In infix this is B^2 - 4AC
;;;
(defun DISCRIMINANT (A B C)
  (- (* B B) (* 4 A C))
)

;;;
;;; Finds the number of real roots that
;;; a quadratic function with the cofficients
;;; has.
;;;
;;; This is done by comparing the discriminant
;;; to zero.
;;;
(defun NUM-REAL-ROOTS (A B C)
  (cond

    ; a=0 and b=0, an impossible situation (no real roots)
    ((and (equal a 0) (equal b 0)) 0)

    ; a=0 (b /= 0 because of above statement)
    ; This is a linear equation with 1 real root.
    ((equal a 0)                   1)

    ; zero real roots since the discriminant < 0
    ((< (DISCRIMINANT A B C) 0)    0)

    ; two real roots since the discriminant > 0
    ((> (DISCRIMINANT A B C) 0)    2)

    ; 1 real root, since the discriminant = 0
    (t                             1)
  )
)

;;;
;;; This function calculates the value of the
;;; quadratic function on the given coefficients
;;; A B C.
;;;
;;; In infix:  -b + sqrt( -b^2 - 4*a*c )
;;;
(defun QUAD-PLUS (A B C)
  (/
    (+ (- B) (sqrt (- (* B B) (* 4 A C))))
    (* 2 A)
  )
)

;;;
;;; This function calculates the value of the
;;; quadratic function on the given coefficients
;;; A B C.
;;;
;;; In infix:  -b - sqrt( -b^2 - 4*a*c )
;;;
(defun QUAD-MINUS (A B C)
  (/
    (- (- B) (sqrt (- (* B B) (* 4 A C))))
    (* 2 A)
  )
)

;;;
;;; This function returns one of the roots of a
;;; quadratic function, with the coefficients
;;; A B C, in a list. If the quadratic function cannot
;;; be applied due to a division by zero, we
;;; will solve the resulting linear function directly.
;;;
(defun QUAD1 (A B C)
  (cond
    ((equal a 0) (list (/ (- C) B))) ;linear function (a=0)
    (t           (list (QUAD-MINUS A B C))) ;any other function
  )
)

;;;
;;; This function returns both roots of a
;;; quadratic function, with the coefficients
;;; A B C, in a list.
;;;
(defun QUAD2 (A B C)
  (list (QUAD-PLUS A B C) (QUAD-MINUS A B C))
)

;;;
;;; This function returns just the real roots of
;;; a quadratic function with with given coefficients
;;; A B C.
;;;
(defun QUAD3 (A B C)
  (cond
    ((equal (NUM-REAL-ROOTS A B C) 2) (QUAD2 A B C))
    ((equal (NUM-REAL-ROOTS A B C) 1) (QUAD1 A B C))
    (t                                nil)
  )
)