<> <> <> <> DIRECTORY Algebra3d, Complex, RealFns, Vector2; Algebra3dImpl: CEDAR PROGRAM IMPORTS Complex, RealFns EXPORTS Algebra3d = BEGIN VEC: TYPE = Vector2.VEC; <> root3Over2: REAL; -- a loadtime constant LinearFormula: PROC [a, b: REAL] RETURNS [root: REAL, rootCount: NAT] = { <> IF a = 0 THEN { IF b = 0 THEN {root _ 0.0; rootCount _ 0; RETURN} ELSE {root _ 0.0; rootCount _ 0; RETURN} -- inconsistent case } ELSE { IF b = 0 THEN {root _ 0.0; rootCount _ 1; RETURN} ELSE {root _ -b/a; rootCount _ 1; RETURN}; }; }; QuadraticFormula: PUBLIC PROC [a, b, c: REAL] RETURNS [roots: ARRAY [1..2] OF REAL, rootCount: NAT] = { <> discriminant, temp: REAL; IF a = 0 THEN { [roots[1], rootCount] _ LinearFormula [b, c]; RETURN; }; IF c = 0 THEN { roots[1] _ 0.0; [roots[2], rootCount] _ LinearFormula[a, b]; rootCount _ rootCount + 1; IF roots[1] > roots[2] THEN { -- swap them temp _ roots[1]; roots[1] _ roots[2]; roots[2] _ temp; }; RETURN}; discriminant _ b*b - 4*a*c; -- 3 mult, 1 add SELECT discriminant FROM =0 => {rootCount _ 1; roots[1] _ -b/(2*a); RETURN}; -- 1 mult, 1 div (4 mult, 1 div, 1 add total) <0 => {rootCount _ 0; RETURN}; -- (3 mult, 1 add total) >0 => { sqrtRadical: REAL _ RealFns.SqRt[discriminant]; term: REAL; rootCount _ 2; term _ IF b < 0 THEN sqrtRadical - b ELSE -sqrtRadical - b; roots[1] _ term/(2.0*a); roots[2] _ (2.0*c)/term; IF roots[1] > roots[2] THEN { -- swap them temp _ roots[1]; roots[1] _ roots[2]; roots[2] _ temp; }; RETURN}; -- 1 SqRt, 2 mult, 2 div, 2 add (1 SqRt, 5 mult, 2 div, 3 add total) ENDCASE => ERROR; }; -- end of QuadraticFormula ToPolar: PROC [vec: VEC] RETURNS [r: REAL, radians: REAL] = { r _ Complex.Abs[vec]; radians _ Complex.Arg[vec]; }; ComplexRoot: PROC [index: REAL, vec: VEC] RETURNS [rootVec: VEC] = { r, radians, resultR, resultRadians: REAL; [r, radians] _ ToPolar[vec]; resultR _ RealFns.Root[index, r]; resultRadians _ radians/index; rootVec _ Complex.FromPolar[resultR, resultRadians]; }; Init: PROC = { root3Over2 _ RealFns.SqRt[3]/2.0; }; Init[]; END.