Subversion Repositories programming

Rev

Rev 63 | Details | Compare with Previous | Last modification | View Log | RSS feed

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