'============================================================================
'  G.H. George                   QUADGEN.BAS                      1996 03 25
'  ENGR 2420                                            modified  1998 03 20
'  Find the solution(s) to the quadratic equation  a z^2 + b z + c = 0
'  in the general case where  a, b, c  are not necessarily real.
'============================================================================

'   Variables:
'           a:  coefficient of  z^2
'           b:  coefficient of  z^1
'           c:  coefficient of  z^0

TYPE COMPLEX
    re AS SINGLE
    im AS SINGLE
END TYPE

'   Procedures:
'       Welcome:    print a welcome message
'     InputData:    get values for the complex coefficients  a, b, c
'         Solve:    solve the quadratic equation & print solutions

DECLARE SUB Welcome ()
DECLARE SUB InputData (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX)
DECLARE SUB Solve (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX)
DECLARE SUB Linear (b AS COMPLEX, c AS COMPLEX)
DECLARE SUB Discriminant (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX, Disc AS COMPLEX)
DECLARE SUB Repeated (a AS COMPLEX, b AS COMPLEX)
DECLARE SUB Distinct (a AS COMPLEX, b AS COMPLEX, Disc AS COMPLEX)
DECLARE SUB Negate (Num AS COMPLEX, Neg AS COMPLEX)
DECLARE SUB Sqrt (x AS COMPLEX, Root AS COMPLEX)
DECLARE SUB Mult (x AS COMPLEX, y AS COMPLEX, Product AS COMPLEX)
DECLARE SUB Divide (x AS COMPLEX, y AS COMPLEX, Quotient AS COMPLEX)
DECLARE SUB Add (x AS COMPLEX, y AS COMPLEX, Sum AS COMPLEX)
DECLARE SUB Subt (x AS COMPLEX, y AS COMPLEX, Diff AS COMPLEX)
DECLARE FUNCTION CPrint$ (z AS COMPLEX)

DIM a AS COMPLEX, b AS COMPLEX, c AS COMPLEX

CALL Welcome
CALL InputData(a, b, c)

CALL Solve(a, b, c)

END

SUB Add (x AS COMPLEX, y AS COMPLEX, Sum AS COMPLEX)
'===========================================================================
'   Returns  Sum = x + y   (Addition of complex numbers)
'===========================================================================

'   Parameters:  (as above)

'   No procedures or local variables

LET Sum.re = x.re + y.re
LET Sum.im = x.im + y.im

END SUB

FUNCTION CPrint$ (z AS COMPLEX)
'===========================================================================
'   Returns a string for printing  z  in cartesian form  x + yj
'===========================================================================

'   Parameters:
'         z:  the complex number to be printed

'   No procedures or local variables

IF z.im = 0 THEN
    LET CPrint$ = LTRIM$(STR$(z.re))                   ' z is real
ELSEIF z.re = 0 THEN
    LET CPrint$ = LTRIM$(STR$(z.im)) + "j"             ' z is pure imaginary
ELSEIF z.im < 0 THEN
    LET CPrint$ = LTRIM$(STR$(z.re)) + " -" + STR$(ABS(z.im)) + "j"  ' x - yj
ELSE
    LET CPrint$ = LTRIM$(STR$(z.re)) + " +" + STR$(z.im) + "j"       ' x + yj
END IF

END FUNCTION

SUB Discriminant (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX, Disc AS COMPLEX)
'============================================================================
'   Evaluate the discriminant   Disc = b^2 - 4ac .
'============================================================================

'   Parameters:
'      a, b, c:   the coefficients of the quadratic equation
'         Disc:   the discriminant   b^2 - 4ac

'   Local variables:
'    (as listed in the DIM statements & as described in the marginal comments)

'   Subprograms:
'        Mult(x, y, z):  finds  z = x * y
'        Subt(x, y, z):  finds  z = x - y

DIM Four AS COMPLEX, a4 AS COMPLEX, bSq AS COMPLEX, ac4 AS COMPLEX

LET Four.re = 4: LET Four.im = 0        ' Four = 4 + 0j

CALL Mult(Four, a, a4)                  ' "a4" = 4 * a
CALL Mult(a4, c, ac4)                   ' "ac4" = 4 * a * c
CALL Mult(b, b, bSq)                    ' bSq = b^2
CALL Subt(bSq, ac4, Disc)               ' Disc = b^2 - 4ac (discriminant)

END SUB

SUB Distinct (a AS COMPLEX, b AS COMPLEX, Disc AS COMPLEX)
'============================================================================
'   Solve the quadratic equation (two distinct solutions case) and display
'   the solutions.
'============================================================================

'   Parameters:
'         a, b:   two of the coefficients of the quadratic equation
'         Disc:   the discriminant   b^2 - 4ac

'   Local Variables:
'       (as noted in the comments below)

'   Procedures:
'      CPrint$:   print item for a complex number in  x + yj  form.
'         Sqrt:   find the principal square root of a complex number.
'       Negate:   negate a complex number
'         Subt:   find  z = x - y  for complex numbers
'          Add:   find  z = x + y  for complex numbers
'         Mult:   find the product of two complex numbers
'       Divide:   find  z = x / y  for complex numbers

DIM Two AS COMPLEX, SqrtDisc AS COMPLEX, bNeg AS COMPLEX
DIM Num AS COMPLEX, Denom AS COMPLEX, z AS COMPLEX

LET Two.re = 2: LET Two.im = 0          ' Two = 2 + 0j

CALL Sqrt(Disc, SqrtDisc)               ' SqrtDisc  <--  sqrt(b^2 - 4ac)
CALL Negate(b, bNeg)                    ' bNeg  <--  -b
CALL Subt(bNeg, SqrtDisc, Num)          ' Num  <--  -b - sqrt(b^2 - 4ac)
CALL Mult(Two, a, Denom)                ' Denom <-- 2 a
CALL Divide(Num, Denom, z)              ' z <-- (-b - sqrt(b^2 - 4ac))/(2a)

PRINT "The solutions are  z = "; CPrint$(z)
PRINT TAB(15); "and  z = ";

CALL Add(bNeg, SqrtDisc, Num)           ' Num  <--  -b + sqrt(b^2 - 4ac)
CALL Divide(Num, Denom, z)              ' z <-- (-b + sqrt(b^2 - 4ac))/(2a)

PRINT CPrint$(z); " ."

'---------------------------------------------------------------------------
' NOTE:
' ====
' An alternative to CALL Negate(b, bNeg) is
'  DIM Zero AS COMPLEX
'  LET Zero.re = 0: LET Zero.im = 0        ' Zero = 0 + 0j
'  CALL Subt(Zero, b, bNeg)

' An alternative to
'  CALL Add(bNeg, SqrtDisc, Num2)          ' Num2  <--  -b + sqrt(b^2 - 4ac)
' is
'  DIM Zero AS COMPLEX, NegDisc AS COMPLEX
'  LET Zero.re = 0: LET Zero.im = 0        ' Zero = 0 + 0j
'  CALL Subt(Zero, SqrtDisc, NegDisc)      ' NegDisc  <--  -sqrt(b^2 - 4ac)
'  CALL Subt(bNeg, NegDisc, Num2)          ' Num2  <--  -b + sqrt(b^2 - 4ac)

' Implementation of both of the above changes allows the program to run
' in the absence of both of the subprograms  Negate  and  Add .

END SUB

SUB Divide (N AS COMPLEX, D AS COMPLEX, Quotient AS COMPLEX)
'===========================================================================
'   Returns  Quotient = N / D   (Division of complex numbers)
'===========================================================================

'   Parameters:  (as above)

'   No procedures or local variables

LET Quotient.re = (N.re * D.re + N.im * D.im) / (D.re * D.re + D.im * D.im)
LET Quotient.im = (N.im * D.re - N.re * D.im) / (D.re * D.re + D.im * D.im)

END SUB

SUB InputData (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX)
'============================================================================
'   Obtain values for the complex coefficients  a, b, c   from the user.
'============================================================================

'   Parameters:
'      a, b, c:   the coefficients of the quadratic equation

'   Local Variables:
'       <none>

'   Procedures:
'      CPrint$:   print item for a complex number in  x + yj  form.

INPUT "Enter the value of the real part of  a: ", a.re
INPUT "Enter the value of the imaginary part of  a: ", a.im
PRINT
INPUT "Enter the value of the real part of  b: ", b.re
INPUT "Enter the value of the imaginary part of  b: ", b.im
PRINT
INPUT "Enter the value of the real part of  c: ", c.re
INPUT "Enter the value of the imaginary part of  c: ", c.im
PRINT

' NOTE:  No data validation is needed at all!
' Echo print the input:

PRINT "The quadratic equation is "
PRINT "      ("; CPrint$(a); ") z^2 + ("; CPrint$(b); ") z + (";
PRINT CPrint$(c); ") = 0 ."
PRINT

END SUB

SUB Linear (b AS COMPLEX, c AS COMPLEX)
'============================================================================
'   Find the solution  z = -c/b  to  the linear equation  b z + c = 0
'============================================================================

'   Parameters:
'         b, c:   the coefficients of the linear equation

'   Local Variables:
'            z:   the solution   -c/b
'         cNeg:   -c

'   Procedures:
'      CPrint$:   print item for a complex number in  x + yj  form.
'       Negate:   set 2nd argument = -(1st argument)
'       Divide:   set 3rd argument = (1st / 2nd)

DIM z AS COMPLEX, cNeg AS COMPLEX

CALL Negate(c, cNeg)                     ' cNeg   <--   -c
CALL Divide(cNeg, b, z)                  ' z  <--  -c / b

PRINT "The unique solution to this LINEAR equation is "
PRINT "   z = "; CPrint$(z); " ."

END SUB

SUB Mult (x AS COMPLEX, y AS COMPLEX, Product AS COMPLEX)
'============================================================================
'   Returns  Product = x * y    (multiplication of complex numbers).
'============================================================================

'   Parameters:  (as above)

'   No procedures or local variables.

LET Product.re = x.re * y.re - x.im * y.im
LET Product.im = x.re * y.im + x.im * y.re

END SUB

SUB Negate (Num AS COMPLEX, Neg AS COMPLEX)
'===========================================================================
'   Returns  Neg = -(Num)   (negates a complex number)
'===========================================================================

'   Parameters:  (as above)

'   No procedures or local variables

LET Neg.re = -Num.re
LET Neg.im = -Num.im

END SUB

SUB Repeated (a AS COMPLEX, b AS COMPLEX)
'============================================================================
'   Print the repeated solution   z = -b / 2a  to the quadratic equation
'    a z^2 + b z + c = 0
'============================================================================

'   Parameters:
'         a, b:   two of the coefficients of the quadratic equation

'   Local variables:
'    (as listed in the DIM statements & as described in the marginal comments)

'   Subprograms:
'        Mult(x, y, z):  finds  z = x * y
'         Negate(x, z):  finds  z = -x
'      Divide(x, y, z):  finds  z = x / y
'           CPrint$(z):  prints the value of  z  in cartesian form.

DIM bNeg AS COMPLEX, Two AS COMPLEX, Denom AS COMPLEX, z AS COMPLEX

LET Two.re = 2: LET Two.im = 0          ' Two = 2 + 0j
CALL Negate(b, bNeg)                    ' bNeg = -b
CALL Mult(Two, a, Denom)                ' Denom = 2a
CALL Divide(bNeg, Denom, z)             ' solution:  z = - b / 2a

PRINT "The quadratic equation has one repeated solution:"
PRINT : PRINT "          z = "; CPrint$(z); " ."

END SUB

SUB Solve (a AS COMPLEX, b AS COMPLEX, c AS COMPLEX)
'============================================================================
'   Solve the quadratic equation and print the solution(s).
'============================================================================

'   Parameters:
'      a, b, c:   the coefficients of the quadratic equation

'   Procedures:
'      CPrint$:   print item for a complex number in  x + yj  form.
'       Linear:   find solution  z = -c/b  to  b z + c = 0
' Discriminant:   find   Disc = b^2 - 4ac
'     Repeated:   find repeated solutions  z = -b/(2a)
'     Distinct:   find distinct solutions  z = (-b +- SQR(Disc))/(2a)

'   Local Variables:
'         Disc:    discriminant of the equation; = b^2 - 4ac

DIM Disc AS COMPLEX
'----------------------------------------------------------
' Check for degenerate cases (a = 0):
'----------------------------------------------------------

IF a.re = 0 AND a.im = 0 THEN

    IF b.re = 0 AND b.im = 0 THEN

        IF c.re = 0 AND c.im = 0 THEN
            PRINT "The equation  0 = 0  has INFINITELY MANY SOLUTIONS."
            PRINT "(Any value of  z  at all is a solution of  0 = 0 .)"
        ELSE
            PRINT "The equation "; CPrint$(c); " = 0 has NO SOLUTIONS at all."
        END IF

    ELSE
        CALL Linear(b, c)
    END IF

'----------------------------------------------------------
' Genuine quadratic equation here:
'----------------------------------------------------------

ELSE
    CALL Discriminant(a, b, c, Disc)

    IF Disc.re = 0 AND Disc.im = 0 THEN
        CALL Repeated(a, b)
    ELSE
        CALL Distinct(a, b, Disc)
    END IF

END IF

END SUB

SUB Sqrt (z AS COMPLEX, Root AS COMPLEX)
'============================================================================
'   Returns  Root = principal square root of  z .
'============================================================================

' Use     Re(sqrt(a + bj)) = + sqrt{ [a + sqrt(a^2 + b^2)] / 2 }
'         Im(sqrt(a + bj)) = ñ sqrt{ [sqrt(a^2 + b^2) - a] / 2 }
' where the principal root is in the first quadrant if  a + bj  is in the
' first or second quadrants, and the principal root is in the fourth
' quadrant otherwise.

'   Parameters:  (as above)

'   No procedures or local variables.

LET Root.re = SQR((z.re + SQR(z.re * z.re + z.im * z.im)) / 2)
LET Root.im = SQR((SQR(z.re * z.re + z.im * z.im) - z.re) / 2)

IF z.im < 0 THEN LET Root.im = -Root.im       ' (4th quadrant)

END SUB

SUB Subt (x AS COMPLEX, y AS COMPLEX, Diff AS COMPLEX)
'===========================================================================
'   Returns  Diff = x - y   (Subtraction of complex numbers)
'===========================================================================

'   Parameters:  (as above)

'   No procedures or local variables

LET Diff.re = x.re - y.re
LET Diff.im = x.im - y.im

END SUB

SUB Welcome
'============================================================================
'   Print a welcome message.
'============================================================================

' No local variables or procedures.

COLOR 15, 0
CLS
PRINT "ENGR 2420 Structured Programming:"; TAB(64); "Dr. G.H. George"
PRINT
PRINT "Find the solution(s) to the quadratic equation  a z^2 + b z + c = 0"
PRINT "in the general case where  a, b, c  are not necessarily real."
PRINT

END SUB