Subversion Repositories programming

Rev

Rev 63 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
63 irasnyd 1 
;Written By: Ira Snyder
2 
;Date:       01-20-2005
3 
;Homework #: 03
4 
 
5 
 
6 
;;;
7 
;;; Finds the discriminant of the quadratic
8 
;;; function with the coefficients A B C
9 
;;;
10 
;;; Given by the value "underneath the root"
11 
;;; In infix this is B^2 - 4AC
12 
;;;
13 
(defun DISCRIMINANT (A B C)
14 
  (- (* B B) (* 4 A C))
15 
)
16 
 
17 
;;;
18 
;;; Finds the number of real roots that
19 
;;; a quadratic function with the cofficients
20 
;;; has.
21 
;;;
22 
;;; This is done by comparing the discriminant
23 
;;; to zero.
24 
;;;
25 
(defun NUM-REAL-ROOTS (A B C)
26 
  (cond
27 
 
28 
    ; a=0 and b=0, an impossible situation (no real roots)
29 
    ((and (equal a 0) (equal b 0)) 0)
30 
 
31 
    ; a=0 (b /= 0 because of above statement)
32 
    ; This is a linear equation with 1 real root.
33 
    ((equal a 0)                   1)
34 
 
35 
    ; zero real roots since the discriminant < 0
36 
    ((< (DISCRIMINANT A B C) 0)    0)
37 
 
38 
    ; two real roots since the discriminant > 0
39 
    ((> (DISCRIMINANT A B C) 0)    2)
40 
 
41 
    ; 1 real root, since the discriminant = 0
42 
    (t                             1)
43 
  )
44 
)
45 
 
46 
;;;
47 
;;; This function calculates the value of the
48 
;;; quadratic function on the given coefficients
49 
;;; A B C.
50 
;;;
51 
;;; In infix:  -b + sqrt( -b^2 - 4*a*c )
52 
;;;
53 
(defun QUAD-PLUS (A B C)
54 
  (/
55 
    (+ (- B) (sqrt (- (* B B) (* 4 A C))))
56 
    (* 2 A)
57 
  )
58 
)
59 
 
60 
;;;
61 
;;; This function calculates the value of the
62 
;;; quadratic function on the given coefficients
63 
;;; A B C.
64 
;;;
65 
;;; In infix:  -b - sqrt( -b^2 - 4*a*c )
66 
;;;
67 
(defun QUAD-MINUS (A B C)
68 
  (/
69 
    (- (- B) (sqrt (- (* B B) (* 4 A C))))
70 
    (* 2 A)
71 
  )
72 
)
73 
 
74 
;;;
75 
;;; This function returns one of the roots of a
76 
;;; quadratic function, with the coefficients
77 
;;; A B C, in a list. If the quadratic function cannot
78 
;;; be applied due to a division by zero, we
79 
;;; will solve the resulting linear function directly.
80 
;;;
81 
(defun QUAD1 (A B C)
82 
  (cond
83 
    ((equal a 0) (list (/ (- C) B))) ;linear function (a=0)
84 
    (t           (list (QUAD-MINUS A B C))) ;any other function
85 
  )
86 
)
87 
 
88 
;;;
89 
;;; This function returns both roots of a
90 
;;; quadratic function, with the coefficients
91 
;;; A B C, in a list.
92 
;;;
93 
(defun QUAD2 (A B C)
94 
  (list (QUAD-PLUS A B C) (QUAD-MINUS A B C))
95 
)
96 
 
97 
;;;
98 
;;; This function returns just the real roots of
99 
;;; a quadratic function with with given coefficients
100 
;;; A B C.
101 
;;;
102 
(defun QUAD3 (A B C)
103 
  (cond
104 
    ((equal (NUM-REAL-ROOTS A B C) 2) (QUAD2 A B C))
105 
    ((equal (NUM-REAL-ROOTS A B C) 1) (QUAD1 A B C))
106 
    (t                                nil)
107 
  )
108 
)
109 
 
110