From 452a2361a43b26089b1ba755f4224935b5b5e033 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Fri, 18 Nov 2022 04:09:42 +1300 Subject: Initial commit --- complex_fixed.gpr | 19 ++ lib/.gitignore | 4 + obj/.gitignore | 4 + src/complex_fixed_points.adb | 529 +++++++++++++++++++++++++++++++++++++++++++ src/complex_fixed_points.ads | 117 ++++++++++ unlicense.txt | 24 ++ 6 files changed, 697 insertions(+) create mode 100644 complex_fixed.gpr create mode 100644 lib/.gitignore create mode 100644 obj/.gitignore create mode 100644 src/complex_fixed_points.adb create mode 100644 src/complex_fixed_points.ads create mode 100644 unlicense.txt diff --git a/complex_fixed.gpr b/complex_fixed.gpr new file mode 100644 index 0000000..1b16010 --- /dev/null +++ b/complex_fixed.gpr @@ -0,0 +1,19 @@ + + +library project Complex_Fixed is + + for Languages use ("Ada"); + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + for Library_Name use "complex_fixed"; + for Library_Kind use "dynamic"; + + package Compiler is + for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM99nprt"); + end Compiler; + +end Complex_Fixed; + + diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/obj/.gitignore b/obj/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/obj/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/src/complex_fixed_points.adb b/src/complex_fixed_points.adb new file mode 100644 index 0000000..a0c7be1 --- /dev/null +++ b/src/complex_fixed_points.adb @@ -0,0 +1,529 @@ + +package body Complex_Fixed_Points is + + -- I have no idea what visibility conflict is requiring these two to be defined + + function "*" + (Left, Right : in Real'Base) + return Real'Base is + begin + return Standard."*" (Left, Right); + end "*"; + + function "/" + (Left, Right : in Real'Base) + return Real'Base is + begin + return Standard."/" (Left, Right); + end "/"; + + + + function Re + (X : in Complex) + return Real'Base is + begin + return X.Re; + end Re; + + function Im + (X : in Complex) + return Real'Base is + begin + return X.Im; + end Im; + + function Im + (X : in Imaginary) + return Real'Base is + begin + return Real'Base (X); + end Im; + + + + procedure Set_Re + (X : in out Complex; + Re : in Real'Base) is + begin + X.Re := Re; + end Set_Re; + + procedure Set_Im + (X : in out Complex; + Im : in Real'Base) is + begin + X.Im := Im; + end Set_Im; + + procedure Set_Im + (X : in out Imaginary; + Im : in Real'Base) is + begin + X := Imaginary (Im); + end Set_Im; + + + + function Cartesian + (Re, Im : in Real'Base) + return Complex is + begin + return (Re => Re, Im => Im); + end Cartesian; + + function Cartesian + (Re : in Real'Base) + return Complex is + begin + return (Re => Re, Im => 0.0); + end Cartesian; + + function Cartesian + (Im : in Imaginary) + return Complex is + begin + return (Re => 0.0, Im => Real'Base (Im)); + end Cartesian; + + + + function Sqrt + (X : in Real'Base) + return Real'Base + is + Old_Result : Real'Base; + Result : Real'Base := 1.0; + Current_Square : Real'Base := 1.0; + Next_L : Real'Base := 3.0; + begin + -- If we don't check for this an overflow will happen due to taking things to the limit + if X = 0.0 then + return 0.0; + end if; + + -- Find the smallest integer greater than Sqrt (X) + while Current_Square < X loop + Current_Square := Current_Square + Next_L; + Next_L := Next_L + 2.0; + Result := Result + 1.0; + end loop; + + -- Lucky guess + if Current_Square = X then + return Result; + end if; + + -- Babylonian aka Newton's Method + -- To be honest I'm kinda suspicious this may not necessarily terminate + loop + Old_Result := Result; + Result := (Old_Result + X / Old_Result) / 2.0; + exit when Real (Result) = Real (Old_Result); + end loop; + return Result; + end Sqrt; + + function Modulus + (X : in Complex) + return Real'Base is + begin + return Sqrt (X.Re * X.Re + X.Im * X.Im); + end Modulus; + + + + function "+" + (Right : in Complex) + return Complex is + begin + return Right; + end "+"; + + function "-" + (Right : in Complex) + return Complex is + begin + return (Re => -Right.Re, Im => -Right.Im); + end "-"; + + function Conjugate + (X : in Complex) + return Complex is + begin + return (Re => X.Re, Im => -X.Im); + end Conjugate; + + + + function "+" + (Left, Right : in Complex) + return Complex is + begin + return (Re => Left.Re + Right.Re, + Im => Left.Im + Right.Im); + end "+"; + + function "-" + (Left, Right : in Complex) + return Complex is + begin + return (Re => Left.Re - Right.Re, + Im => Left.Im - Right.Im); + end "-"; + + function "*" + (Left, Right : in Complex) + return Complex is + begin + return (Re => Left.Re * Right.Re - Left.Im * Right.Im, + Im => Left.Re * Right.Im + Left.Im * Right.Re); + end "*"; + + function "/" + (Left, Right : in Complex) + return Complex + is + Denominator : Real'Base := Right.Re * Right.Re + Right.Im * Right.Im; + begin + return (Re => (Left.Re * Right.Re + Left.Im * Right.Im) / Denominator, + Im => (Left.Im * Right.Re - Left.Re * Right.Im) / Denominator); + end "/"; + + + + function "**" + (Left : in Complex; + Right : in Integer) + return Complex + is + Result : Complex; + Exponent : Integer := Right; + begin + if Exponent >= 1 then + Result := Left; + while Exponent > 1 loop + Result := Result * Left; + Exponent := Exponent - 1; + end loop; + else + Result := One; + while Exponent < 0 loop + Result := Result / Left; + Exponent := Exponent + 1; + end loop; + end if; + return Result; + end "**"; + + + + function "+" + (Right : in Imaginary) + return Imaginary is + begin + return Right; + end "+"; + + function "-" + (Right : in Imaginary) + return Imaginary is + begin + return Imaginary (-Real'Base (Right)); + end "-"; + + function "abs" + (Right : in Imaginary) + return Real'Base is + begin + return abs (Real'Base (Right)); + end "abs"; + + + + function "+" + (Left, Right : in Imaginary) + return Imaginary is + begin + return Imaginary (Real'Base (Left) + Real'Base (Right)); + end "+"; + + function "-" + (Left, Right : in Imaginary) + return Imaginary is + begin + return Imaginary (Real'Base (Left) - Real'Base (Right)); + end "-"; + + function "*" + (Left, Right : in Imaginary) + return Real'Base is + begin + return -(Real'Base (Left) * Real'Base (Right)); + end "*"; + + function "/" + (Left, Right : in Imaginary) + return Real'Base is + begin + return Real'Base (Left) / Real'Base (Right); + end "/"; + + + + function "**" + (Left : in Imaginary; + Right : in Integer) + return Complex + is + Result : Complex; + Exponent : Integer := Right; + begin + if Exponent >= 1 then + Result := Cartesian (Left); + while Exponent > 1 loop + Result := Result * Left; + Exponent := Exponent - 1; + end loop; + else + Result := One; + while Exponent < 0 loop + Result := Result / Left; + Exponent := Exponent + 1; + end loop; + end if; + return Result; + end "**"; + + + + function "<" + (Left, Right : in Imaginary) + return Boolean is + begin + return Real'Base (Left) < Real'Base (Right); + end "<"; + + function "<=" + (Left, Right : in Imaginary) + return Boolean is + begin + return Real'Base (Left) <= Real'Base (Right); + end "<="; + + function ">" + (Left, Right : in Imaginary) + return Boolean is + begin + return Real'Base (Left) > Real'Base (Right); + end ">"; + + function ">=" + (Left, Right : in Imaginary) + return Boolean is + begin + return Real'Base (Left) >= Real'Base (Right); + end ">="; + + + + function "+" + (Left : in Complex; + Right : in Real'Base) + return Complex is + begin + return (Re => Left.Re + Right, Im => Left.Im); + end "+"; + + function "+" + (Left : in Real'Base; + Right : in Complex) + return Complex is + begin + return Right + Left; + end "+"; + + function "-" + (Left : in Complex; + Right : in Real'Base) + return Complex is + begin + return (Re => Left.Re - Right, Im => Left.Im); + end "-"; + + function "-" + (Left : in Real'Base; + Right : in Complex) + return Complex is + begin + return (Re => Left - Right.Re, Im => -Right.Im); + end "-"; + + function "*" + (Left : in Complex; + Right : in Real'Base) + return Complex is + begin + return (Re => Left.Re * Right, Im => Left.Im * Right); + end "*"; + + function "*" + (Left : in Real'Base; + Right : in Complex) + return Complex is + begin + return Right * Left; + end "*"; + + function "/" + (Left : in Complex; + Right : in Real'Base) + return Complex is + begin + return (Re => Left.Re / Right, Im => Left.Im / Right); + end "/"; + + function "/" + (Left : in Real'Base; + Right : in Complex) + return Complex is + begin + return Cartesian (Left) / Right; + end "/"; + + + + function "+" + (Left : in Complex; + Right : in Imaginary) + return Complex is + begin + return (Re => Left.Re, Im => Left.Im + Real'Base (Right)); + end "+"; + + function "+" + (Left : in Imaginary; + Right : in Complex) + return Complex is + begin + return Right + Left; + end "+"; + + function "-" + (Left : in Complex; + Right : in Imaginary) + return Complex is + begin + return (Re => Left.Re, Im => Left.Im - Real'Base (Right)); + end "-"; + + function "-" + (Left : in Imaginary; + Right : in Complex) + return Complex is + begin + return (Re => -Right.Re, Im => Real'Base (Left) - Right.Im); + end "-"; + + function "*" + (Left : in Complex; + Right : in Imaginary) + return Complex is + begin + return (Re => -Left.Im * Real'Base (Right), + Im => Left.Re * Real'Base (Right)); + end "*"; + + function "*" + (Left : in Imaginary; + Right : in Complex) + return Complex is + begin + return Right * Left; + end "*"; + + function "/" + (Left : in Complex; + Right : in Imaginary) + return Complex is + begin + return (Re => Left.Im / Real'Base (Right), + Im => -Left.Re / Real'Base (Right)); + end "/"; + + function "/" + (Left : in Imaginary; + Right : in Complex) + return Complex is + begin + return Cartesian (Left) / Right; + end "/"; + + + + function "+" + (Left : in Imaginary; + Right : in Real'Base) + return Complex is + begin + return (Re => Right, Im => Real'Base (Left)); + end "+"; + + function "+" + (Left : in Real'Base; + Right : in Imaginary) + return Complex is + begin + return (Re => Left, Im => Real'Base (Right)); + end "+"; + + function "-" + (Left : in Imaginary; + Right : in Real'Base) + return Complex is + begin + return (Re => -Right, Im => Real'Base (Left)); + end "-"; + + function "-" + (Left : in Real'Base; + Right : in Imaginary) + return Complex is + begin + return (Re => Left, Im => -Real'Base (Right)); + end "-"; + + function "*" + (Left : in Imaginary; + Right : in Real'Base) + return Imaginary is + begin + return Imaginary (Standard."*" (Right, Real'Base (Left))); + end "*"; + + function "*" + (Left : in Real'Base; + Right : in Imaginary) + return Imaginary is + begin + return Imaginary (Standard."*" (Left, Real'Base (Right))); + end "*"; + + function "/" + (Left : in Imaginary; + Right : in Real'Base) + return Imaginary is + begin + return Imaginary (Standard."/" (Real'Base (Left), Right)); + end "/"; + + function "/" + (Left : in Real'Base; + Right : in Imaginary) + return Imaginary is + begin + return -Imaginary (Standard."/" (Left, Real'Base (Right))); + end "/"; + +end Complex_Fixed_Points; + diff --git a/src/complex_fixed_points.ads b/src/complex_fixed_points.ads new file mode 100644 index 0000000..97667b1 --- /dev/null +++ b/src/complex_fixed_points.ads @@ -0,0 +1,117 @@ + +generic + type Real is delta <> digits <>; +package Complex_Fixed_Points is + + pragma Pure (Complex_Fixed_Points); + + type Complex is private; + type Imaginary is private; + pragma Preelaborable_Initialization (Imaginary); + + i : constant Imaginary; + j : constant Imaginary; + + Zero : constant Complex; + One : constant Complex; + + function Re (X : in Complex) return Real'Base; + function Im (X : in Complex) return Real'Base; + function Im (X : in Imaginary) return Real'Base; + + procedure Set_Re + (X : in out Complex; + Re : in Real'Base); + procedure Set_Im + (X : in out Complex; + Im : in Real'Base); + procedure Set_Im + (X : in out Imaginary; + Im : in Real'Base); + + function Cartesian (Re, Im : in Real'Base) return Complex; + function Cartesian (Re : in Real'Base) return Complex; + function Cartesian (Im : in Imaginary) return Complex; + + function Modulus (X : in Complex) return Real'Base; + function "abs" (Right : in Complex) return Real'Base renames Modulus; + + -- Like hell am I writing fixed point trig functions right now. + + -- function Argument (X : in Complex) return Real'Base; + -- function Argument (X : in Complex; Cycle : in Real'Base) return Real'Base; + + -- function Polar (Modulus, Argument : in Real'Base) return Complex; + -- function Polar (Modulus, Argument, Cycle : in Real'Base) return Complex; + + function "+" (Right : in Complex) return Complex; + function "-" (Right : in Complex) return Complex; + function Conjugate (X : in Complex) return Complex; + + function "+" (Left, Right : in Complex) return Complex; + function "-" (Left, Right : in Complex) return Complex; + function "*" (Left, Right : in Complex) return Complex; + function "/" (Left, Right : in Complex) return Complex; + + function "**" (Left : in Complex; Right : in Integer) return Complex; + + function "+" (Right : in Imaginary) return Imaginary; + function "-" (Right : in Imaginary) return Imaginary; + function Conjugate (X : in Imaginary) return Imaginary renames "-"; + function "abs" (Right : in Imaginary) return Real'Base; + + function "+" (Left, Right : in Imaginary) return Imaginary; + function "-" (Left, Right : in Imaginary) return Imaginary; + function "*" (Left, Right : in Imaginary) return Real'Base; + function "/" (Left, Right : in Imaginary) return Real'Base; + + function "**" (Left : in Imaginary; Right : in Integer) return Complex; + + function "<" (Left, Right : in Imaginary) return Boolean; + function "<=" (Left, Right : in Imaginary) return Boolean; + function ">" (Left, Right : in Imaginary) return Boolean; + function ">=" (Left, Right : in Imaginary) return Boolean; + + function "+" (Left : in Complex; Right : in Real'Base) return Complex; + function "+" (Left : in Real'Base; Right : in Complex) return Complex; + function "-" (Left : in Complex; Right : in Real'Base) return Complex; + function "-" (Left : in Real'Base; Right : in Complex) return Complex; + function "*" (Left : in Complex; Right : in Real'Base) return Complex; + function "*" (Left : in Real'Base; Right : in Complex) return Complex; + function "/" (Left : in Complex; Right : in Real'Base) return Complex; + function "/" (Left : in Real'Base; Right : in Complex) return Complex; + + function "+" (Left : in Complex; Right : in Imaginary) return Complex; + function "+" (Left : in Imaginary; Right : in Complex) return Complex; + function "-" (Left : in Complex; Right : in Imaginary) return Complex; + function "-" (Left : in Imaginary; Right : in Complex) return Complex; + function "*" (Left : in Complex; Right : in Imaginary) return Complex; + function "*" (Left : in Imaginary; Right : in Complex) return Complex; + function "/" (Left : in Complex; Right : in Imaginary) return Complex; + function "/" (Left : in Imaginary; Right : in Complex) return Complex; + + function "+" (Left : in Imaginary; Right : in Real'Base) return Complex; + function "+" (Left : in Real'Base; Right : in Imaginary) return Complex; + function "-" (Left : in Imaginary; Right : in Real'Base) return Complex; + function "-" (Left : in Real'Base; Right : in Imaginary) return Complex; + function "*" (Left : in Imaginary; Right : in Real'Base) return Imaginary; + function "*" (Left : in Real'Base; Right : in Imaginary) return Imaginary; + function "/" (Left : in Imaginary; Right : in Real'Base) return Imaginary; + function "/" (Left : in Real'Base; Right : in Imaginary) return Imaginary; + +private + + type Complex is record + Re, Im : Real'Base; + end record; + + type Imaginary is new Real'Base; + + i : constant Imaginary := 1.0; + j : constant Imaginary := 1.0; + + Zero : constant Complex := (Re => 0.0, Im => 0.0); + One : constant Complex := (Re => 1.0, Im => 0.0); + +end Complex_Fixed_Points; + diff --git a/unlicense.txt b/unlicense.txt new file mode 100644 index 0000000..68a49da --- /dev/null +++ b/unlicense.txt @@ -0,0 +1,24 @@ +This is free and unencumbered software released into the public domain. + +Anyone is free to copy, modify, publish, use, compile, sell, or +distribute this software, either in source code form or as a compiled +binary, for any purpose, commercial or non-commercial, and by any +means. + +In jurisdictions that recognize copyright laws, the author or authors +of this software dedicate any and all copyright interest in the +software to the public domain. We make this dedication for the benefit +of the public at large and to the detriment of our heirs and +successors. We intend this dedication to be an overt act of +relinquishment in perpetuity of all present and future rights to this +software under copyright law. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. + +For more information, please refer to -- cgit