with Basic_Io; use Basic_Io;
with Ada.Characters.Handling;
with Ada.Strings;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Exceptions; use Ada.Exceptions;
with Mathematics; use Mathematics;
with LaTex; use LaTex;
package body Geometric_Algebra_Generic is
procedure Put (Value : Bit_Type);
function Get_Dimension return Natural is
begin
return Dimension;
end Get_Dimension;
function Get_Max_Blade_Length return Natural is
Length : Natural := 0;
Result : Natural := 0;
begin
for i in 0 .. Dimension loop
Result := N_over_K (Dimension, i);
if Result > Length then
Length := Result;
end if;
end loop;
return Length;
end Get_Max_Blade_Length;
function "*"
(Left : Canonic_Base_Element_Type;
Right : Canonic_Base_Element_Type) return Canonic_Base_Element_Type is
Product : Canonic_Base_Element_Type;
Element_Exists : Boolean := True;
Further_Elements : Boolean := False;
Sub_is_Opened : Boolean := False;
use Ada.Strings;
Signum_Value : Integer := 1;
begin
Signum_Value := Signum (Left.Base, Right.Base);
Product.Value := Left.Value * Right.Value * Float (Signum_Value);
for j in Product.Base'range loop
Element_Exists := (Left.Base (j) /= Right.Base (j));
if Element_Exists then
Product.Base (j) := 1;
else
Product.Base (j) := 0;
end if;
end loop;
if Signum_Value = -1 then
Append (Product.Name, "-");
Append (Product.HTML_Name, "-");
end if;
for j in Product.Base'range loop
if Product.Base (j) = 1 then
Append
(Product.Name,
"e" & Trim (Source => (To_Unbounded_String (Integer'image (j))), Side => Ada.Strings.Left));
Append
(Product.HTML_Name,
"e<sub>" & Trim (Source => (To_Unbounded_String (Integer'image (j))), Side => Ada.Strings.Left));
Sub_is_Opened := True;
if j = Product.Base'last then
if Sub_is_Opened then
Append (Product.HTML_Name, "</sub>");
Sub_is_Opened := False;
end if;
exit;
end if;
for k in (j + 1) .. Product.Base'last loop
if Product.Base (k) = 1 then
Further_Elements := True;
exit;
end if;
end loop;
if (Further_Elements) then
Append (Product.Name, "^");
Append (Product.HTML_Name, "</sub>∧");
Further_Elements := False;
Sub_is_Opened := False;
else
if Sub_is_Opened then
Append (Product.HTML_Name, "</sub>");
Sub_is_Opened := False;
end if;
end if;
end if;
if Sub_is_Opened then
Append (Product.HTML_Name, "</sub>");
Sub_is_Opened := False;
end if;
end loop;
if Product.Name = Null_Unbounded_String or Product.Name = To_Unbounded_String ("-") then Append (Product.Name, "1");
Append (Product.HTML_Name, "1");
end if;
return Product;
exception
when Error : others =>
Put_Line
("Error in function * (Left : Canonic_Base_Element_Type; Right : Canonic_Base_Element_Type) return Canonic_Base_Element_Type"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end "*";
function Create_Canonic_Base return Multi_Vector_Type is
Canonic_Base : Multi_Vector_Type;
Further_Elements : Boolean := False;
Sub_is_Opened : Boolean := False;
Grade : Natural := 0;
use Ada.Strings;
begin
for I in Canonic_Base'range loop
Canonic_Base (I).Value := 1.0;
if I > Canonic_Base'first then
Canonic_Base (I) := Canonic_Base (I - 1);
Inner :
for J in Canonic_Base (I).Base'range loop
if (Canonic_Base (I).Base (J) = 0) then
Canonic_Base (I).Base (J) := 1;
exit Inner;
else
Canonic_Base (I).Base (J) := 0;
end if;
end loop Inner;
end if;
end loop;
for I in Canonic_Base'range loop
for j in Canonic_Base (I).Base'range loop
if Canonic_Base (I).Base (j) = 1 then
Grade := Grade + 1;
end if;
end loop;
Canonic_Base (I).Grade := Grade;
Grade := 0;
end loop;
for I in Canonic_Base'range loop
if I = 0 then
Canonic_Base (I).Name := Canonic_Base (I).Name & "1";
Canonic_Base (I).HTML_Name := Canonic_Base (I).HTML_Name & "1";
Canonic_Base (I).Latex_Name := Canonic_Base (I).Latex_Name & "1";
else
for j in Canonic_Base (I).Base'range loop
if Canonic_Base (I).Base (j) = 1 then
Append
(Canonic_Base (I).Name,
"e" & Trim (Source => (To_Unbounded_String (Integer'image (j))), Side => Left));
Append
(Canonic_Base (I).HTML_Name,
"e<sub>" & Trim (Source => (To_Unbounded_String (Integer'image (j))), Side => Left));
Append
(Canonic_Base (I).Latex_Name,
"e_{" & Trim (Source => (To_Unbounded_String (Integer'image (j))), Side => Left)); Sub_is_Opened := True;
if ((j = Canonic_Base (I).Base'last)) then
exit;
end if;
for k in (j + 1) .. Canonic_Base (I).Base'last loop
if Canonic_Base (I).Base (k) = 1 then
Further_Elements := True;
exit;
end if;
end loop;
if (Further_Elements) then
Append (Canonic_Base (I).Name, "^");
if Sub_is_Opened then
Append (Canonic_Base (I).HTML_Name, "</sub>∧");
Append (Canonic_Base (I).Latex_Name, "}\wedge ");
Sub_is_Opened := False;
end if;
Further_Elements := False;
else
if Sub_is_Opened then
Append (Canonic_Base (I).HTML_Name, "</sub>");
Append (Canonic_Base (I).Latex_Name, "}");
Sub_is_Opened := False;
end if;
end if;
end if;
end loop;
if Sub_is_Opened then
Append (Canonic_Base (I).HTML_Name, "</sub>");
Append (Canonic_Base (I).Latex_Name, "}");
Sub_is_Opened := False;
end if;
end if;
end loop;
return Canonic_Base;
exception
when Error : others =>
Put_Line ("Error in function Create_Canonic_Base."); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Canonic_Base;
function Create_Zero_Multivector return Multi_Vector_Type is
Zero_Multivector : Multi_Vector_Type;
begin
Zero_Multivector := Create_Canonic_Base;
for i in Zero_Multivector'range loop
Zero_Multivector (i).Value := 0.0;
end loop;
return Zero_Multivector;
end Create_Zero_Multivector;
procedure Put_Multi_Vector (Value : Multi_Vector_Type) is
begin
for I in Value'range loop
Put ("Element: "); if I < 10 then
Put (" " & Integer'image (I) & ": "); else
Put (Integer'image (I) & ": ");
end if;
Put ("Value: " & Float'image (Value (I).Value)); Put (" Grade:" & Integer'image (Value (I).Grade) & " Base: ");
for j in Value (I).Base'range loop
Put (Value (I).Base (j));
end loop;
Put (" Name: " & To_String (Value (I).Name)); New_Line;
end loop;
end Put_Multi_Vector;
procedure Set_Element (Multi_Vector : in out Multi_Vector_Type; Element : Natural; Value : Float) is
begin
Multi_Vector (Element).Value := Value;
end Set_Element;
procedure Put_Line (Value : Multi_Vector_Type) is
begin
for I in Value'range loop
Put ("Value: " & Float'image (Value (I).Value) & " Name: " & To_String (Value (I).Name)); New_Line;
end loop;
end Put_Line;
function Get_Base_of_Same_Grad (Grade : Natural) return Unbounded_String is
Base_Same_Grad : Unbounded_String := Null_Unbounded_String;
Canonic_Base : Multi_Vector_Type := Create_Canonic_Base;
First : Boolean := True;
begin
for i in Canonic_Base'range loop
if Canonic_Base (i).Grade = Grade then
if First then
Append (Base_Same_Grad, Canonic_Base (i).Name);
First := False;
else
Append (Base_Same_Grad, ", " & Canonic_Base (i).Name);
end if;
end if;
end loop;
return Base_Same_Grad;
end Get_Base_of_Same_Grad;
function Number_of_Elements (Grade : Natural) return Natural is
Number_of_Elements : Natural := 0;
Canonic_Base : Multi_Vector_Type := Create_Canonic_Base;
First : Boolean := True;
begin
for i in Canonic_Base'range loop
if Canonic_Base (i).Grade = Grade then
Number_of_Elements := Number_of_Elements + 1;
end if;
end loop;
return Number_of_Elements;
end Number_of_Elements;
function Prepare_Base_Name_Table_ASCII return String_Matrix_Type is
Matrix : String_Matrix_Type (-1 .. Dimension, -2 .. Max_Blade_Length - 1);
Number_of_Grade_Elements : array (0 .. Dimension) of Integer := (others => 0);
begin
Append (Matrix (-1, -2), "Grade");
Append (Matrix (-1, -1), "Elements");
for K in 0 .. Dimension loop
Matrix (K, -2) := To_Unbounded_String (Integer'image (K));
Matrix (K, -1) := To_Unbounded_String (Integer'image (Number_of_Elements (K)));
end loop;
for i in Canonic_Base'first .. Canonic_Base'last loop
Put_Line (To_String (Canonic_Base (i).Name));
Put_Line ("Grade: " & Integer'image (Canonic_Base (i).Grade)); Matrix (Canonic_Base (i).Grade, Number_of_Grade_Elements (Canonic_Base (i).Grade)) := Canonic_Base (i).Name;
Number_of_Grade_Elements (Canonic_Base (i).Grade) := Number_of_Grade_Elements (Canonic_Base (i).Grade) + 1;
Put_Line ("Element: " & Integer'image (Number_of_Grade_Elements (Canonic_Base (i).Grade))); New_Line;
end loop;
return Matrix;
end Prepare_Base_Name_Table_ASCII;
function Prepare_Base_Name_Table_HTML return String_Matrix_Type is
Matrix : String_Matrix_Type (-1 .. Dimension, -2 .. Max_Blade_Length - 1);
Number_of_Grade_Elements : array (0 .. Dimension) of Integer := (others => 0);
begin
Append (Matrix (-1, -2), "Grade");
Append (Matrix (-1, -1), "Elements");
for K in 0 .. Dimension loop
Matrix (K, -2) := To_Unbounded_String (Integer'image (K));
Matrix (K, -1) := To_Unbounded_String (Integer'image (Number_of_Elements (K)));
end loop;
for i in Canonic_Base'first .. Canonic_Base'last loop
Matrix (Canonic_Base (i).Grade, Number_of_Grade_Elements (Canonic_Base (i).Grade)) :=
Canonic_Base (i).HTML_Name;
Number_of_Grade_Elements (Canonic_Base (i).Grade) := Number_of_Grade_Elements (Canonic_Base (i).Grade) + 1;
end loop;
return Matrix;
end Prepare_Base_Name_Table_HTML;
function Prepare_Base_Name_Table_LaTex return String_Matrix_Type is
Matrix : String_Matrix_Type (-1 .. Dimension, -2 .. Max_Blade_Length - 1);
Number_of_Grade_Elements : array (0 .. Dimension) of Integer := (others => 0);
begin
Append (Matrix (-1, -2), "Grade");
Append (Matrix (-1, -1), "Elements");
for K in 0 .. Dimension loop
Matrix (K, -2) := To_Unbounded_String (Integer'image (K));
Matrix (K, -1) := To_Unbounded_String (Integer'image (Number_of_Elements (K)));
end loop;
for i in Canonic_Base'first .. Canonic_Base'last loop
Matrix (Canonic_Base (i).Grade, Number_of_Grade_Elements (Canonic_Base (i).Grade)) :=
Canonic_Base (i).Latex_Name;
Number_of_Grade_Elements (Canonic_Base (i).Grade) := Number_of_Grade_Elements (Canonic_Base (i).Grade) + 1;
end loop;
return Matrix;
end Prepare_Base_Name_Table_LaTex;
procedure Create_Base_Vector_Table_HTML (File_Name : String := "base_vectors_table.html") is
Out_File : File_Type;
Table : Unbounded_String := Null_Unbounded_String;
String_Matrix : String_Matrix_Type := Prepare_Base_Name_Table_HTML;
Head_Contens_Default : Unbounded_String :=
To_Unbounded_String
("<style type=" & Quotation &
"text/css" &
Quotation &
">" &
"div, h1, h2, table, tr, td, img { margin:0px; padding:0px; }" & "</style>");
begin
Create (File => Out_File, Name => File_Name);
Table := HTML.Table (String_Matrix, Mark_first_Column => True);
Put_Line (Out_File, To_String (HTML.HTML_Document (Head_Contens => Head_Contens_Default, Body_Contens => Table)));
Close (Out_File);
exception
when Error : others =>
Put_Line ("Error in procedure Create_Base_Vector_Table_HTML"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Base_Vector_Table_HTML;
function Create_Multiplikation_Table return String_Matrix_Type is
Matrix : String_Matrix_Type (-1 .. Base_Dimension - 1, -1 .. Base_Dimension - 1);
Product : Canonic_Base_Element_Type;
begin
Put_Line ("begin Create_Multiplikation_Table"); for i in One'range loop
Matrix (-1, i) := One (i).HTML_Name;
Matrix (i, -1) := One (i).HTML_Name;
end loop;
for i in One'range loop
for j in One'range loop
Product := One (i) * One (j);
Matrix (i, j) := Product.HTML_Name;
end loop;
end loop;
Put_Line ("end Create_Multiplikation_Table"); return Matrix;
exception
when Error : others =>
Put_Line ("Error in function Create_Multiplikation_Table"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Multiplikation_Table;
function Prepare_Multiplikation_Table_Short_Form_HTML return String_Matrix_Type is
Matrix : String_Matrix_Type (0 .. Base_Dimension - 1, 0 .. Base_Dimension - 1);
Product : Canonic_Base_Element_Type;
Element_Name : Unbounded_String := Null_Unbounded_String;
First_Time : Boolean := True;
use Ada.Strings;
begin
Put_Line ("begin Prepare_Multiplikation_Table_Short_Form");
for i in One'range loop
for j in One'range loop
Product := One (i) * One (j);
if Product.Name = "1" then
Matrix (i, j) := To_Unbounded_String ("1"); elsif Product.Name = "-1" then
Matrix (i, j) := To_Unbounded_String ("-1"); else
if Product.Value < 0.0 then
Matrix (i, j) := To_Unbounded_String ("-"); else
Matrix (i, j) := To_Unbounded_String (" "); end if;
Append (Matrix (i, j), "e<sub>");
for k in Product.Base'range loop
if Product.Base (k) = 1 then
Append (Matrix (i, j), Trim (Source => (To_Unbounded_String (Integer'image (k))), Side => Left));
end if;
end loop;
Append (Matrix (i, j), "</sub>");
end if;
end loop;
end loop;
Put_Line ("end Prepare_Multiplikation_Table_Short_Form"); return Matrix;
exception
when Error : others =>
Put_Line ("Error in function Create_Multiplikation_Table_Short_Form"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Prepare_Multiplikation_Table_Short_Form_HTML;
procedure Create_Multipikation_Table_HTML (File_Name : String := "multiplication_table.html") is
Out_File : File_Type;
String_Matrix : String_Matrix_Type := Create_Multiplikation_Table;
Table : Unbounded_String := Null_Unbounded_String;
begin
Put_Line ("begin Create_Multipikation_Table_HTML"); Create (File => Out_File, Name => File_Name);
Put_Line ("File opened!"); Table := HTML.Table (String_Matrix, Head_Line => True, Mark_first_Column => True);
Put_Line ("HTML.Table is defined!"); declare
Document : String := To_String (HTML.HTML_Document (Body_Contens => Table));
begin
Put_Line ("HTML Document defined!"); delay 2.0;
for j in Document'range loop
Put (Out_File, Document (j));
end loop;
exception
when Error : others =>
Put_Line ("Error while defining HTML-Document"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); end;
Put_Line ("HTML document is written!"); Close (Out_File);
Put_Line ("end Create_Multipikation_Table_HTML"); exception
when Error : others =>
Put_Line ("Error in procedure Create_Multipikation_Table_HTML"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Multipikation_Table_HTML;
procedure Create_Multipikation_Table_HTML_Short_Form (File_Name : String := "multiplication_table_short.html") is
Out_File : File_Type;
String_Matrix : String_Matrix_Type := Prepare_Multiplikation_Table_Short_Form_HTML;
Table : Unbounded_String := Null_Unbounded_String;
begin
Put_Line ("begin Create_Multipikation_Table_HTML_Short_form"); Create (File => Out_File, Name => File_Name);
Put_Line ("File opened!"); Table := HTML.Table (String_Matrix, Head_Line => False, Mark_first_Column => False, Text_Align => Center);
Put_Line ("HTML.Table is defined!"); declare
Document : String := To_String (HTML.HTML_Document (Body_Contens => Table));
begin
Put_Line ("HTML Document defined!"); delay 2.0;
for j in Document'range loop
Put (Out_File, Document (j));
end loop;
exception
when Error : others =>
Put_Line ("Error while defining HTML-Document"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); end;
Put_Line ("HTML document is written!"); Close (Out_File);
Put_Line ("end Create_Multipikation_Table_HTML_Short_Form"); exception
when Error : others =>
Put_Line ("Error in procedure Create_Multipikation_Table_HTML_Short_Form"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Multipikation_Table_HTML_Short_Form;
procedure Create_Multiplication_Table_Latex (File_Name : String := "multiplication_table.lat") is
Out_File : File_Type;
String_Matrix : String_Matrix_Type := Create_Multiplikation_Table;
Table : Unbounded_String := Null_Unbounded_String;
begin
Put_Line ("begin Create_Multipikation_Table_Latex "); Create (File => Out_File, Name => File_Name);
Table := LaTex.Table (String_Matrix);
Put_Line (Out_File, To_String (Table));
Close (Out_File);
Put_Line ("end Create_Multipikation_Table_Latex "); exception
when Error : others =>
Put_Line ("Error in procedure Create_Multiplikation_Table_LaTex"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Multiplication_Table_Latex;
procedure Create_Multiplication_Table_Latex_Short_Form (File_Name : String := "multiplication_table.lat") is
Out_File : File_Type;
String_Matrix : String_Matrix_Type := Prepare_Multiplikation_Table_Short_Form_HTML;
Table : Unbounded_String := Null_Unbounded_String;
begin
Put_Line ("begin Create_Multiplication_Table_Latex_Short_Form"); Create (File => Out_File, Name => File_Name);
Table := LaTex.Table_Short_Form (String_Matrix);
Put_Line (Out_File, To_String (Table));
Close (Out_File);
Put_Line ("end Create_Multiplication_Table_Latex_Short_Form "); exception
when Error : others =>
Put_Line ("Error in procedure Create_Multiplication_Table_LaTex_Short_Form"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Multiplication_Table_Latex_Short_Form;
procedure Create_Base_Vector_Table_LaTex (File_Name : String := "base_vectors_table.lat"; Formular_Elements : Boolean := true) is
Out_File : File_Type;
Table : Unbounded_String := Null_Unbounded_String;
String_Matrix : String_Matrix_Type := Prepare_Base_Name_Table_LaTex;
begin
Put_Line ("begin Create_Base_Vector_Table_LaTex"); Create (File => Out_File, Name => File_Name);
Table := LaTex.Table (String_Matrix, Head_Line => true, Formular_Elements => Formular_Elements);
Put_Line (Out_File, To_String (Table));
Close (Out_File);
Put_Line ("end Create_Base_Vector_Table_LaTex"); exception
when Error : others =>
Put_Line ("Error in procedure Create_Base_Vector_Table_LaTex"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Create_Base_Vector_Table_LaTex;
procedure Put (Value : Bit_Type) is
begin
Put (Bit_Type'image (Value));
end Put;
function Scalar_Product (Left, Right : Vector_Type) return Float is
Product : Float := 0.0;
begin
for I in Left'range loop
Product := Product + Left (I) * Right (I);
end loop;
return Product;
end Scalar_Product;
function "+" (Left : Multi_Vector_Type; Right : Multi_Vector_Type) return Multi_Vector_Type is
Sum : Multi_Vector_Type := Zero_Multivector;
begin
for i in Sum'range loop
Sum (i).Value := Left (i).Value + Right (i).Value;
end loop;
return Sum;
end "+";
function "-" (Left : Multi_Vector_Type; Right : Multi_Vector_Type) return Multi_Vector_Type is
Diff : Multi_Vector_Type := Zero_Multivector;
begin
for i in Diff'range loop
Diff (i).Value := Left (i).Value - Right (i).Value;
end loop;
return Diff;
end "-";
function "*" (Left : Float; Right : Multi_Vector_Type) return Multi_Vector_Type is
Product : Multi_Vector_Type := Zero_Multivector;
begin
for i in Product'range loop
Product (i).Value := Left * Right (i).Value;
end loop;
return Product;
end "*";
function "*" (Left : Multi_Vector_Type; Right : Float) return Multi_Vector_Type is
Product : Multi_Vector_Type := Zero_Multivector;
begin
for i in Product'range loop
Product (i).Value := Left (i).Value * Right;
end loop;
return Product;
end "*";
function Signum (Left : Bit_Array_Type; Right : Bit_Array_Type) return Integer is
Count : Integer := 0;
Max : Integer := 0;
Shifted : Bit_Array_Type := Right;
Zero : constant Bit_Array_Type := (others => 0);
End_Reached : Boolean := False;
begin
for j in Left'range loop
Shifted := Zero;
for k in Shifted'range loop
End_Reached := j + k > Left'last;
exit when End_Reached;
Shifted (k) := Left (k + j);
end loop;
for K in Left'range loop
if Right (K) = Shifted (K) and Shifted (K) = 1 then
Count := Count + 1;
end if;
end loop;
end loop;
if (Count mod 2) = 0 then
return 1;
else
return -1;
end if;
exception
when Error : others =>
Put_Line ("Error in function Signum"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); raise;
end Signum;
function "*" (Left : Multi_Vector_Type; Right : Multi_Vector_Type) return Multi_Vector_Type is
Product : Multi_Vector_Type := Zero_Multivector;
begin
Put_Line ("Function not implemented!"); return Product;
exception
when Error : others =>
Put_Line
("Error in function: * (Left : Multi_Vector_Type; Right : Multi_Vector_Type) return Multi_Vector_Type"); Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error)); return Zero_Multivector;
end "*";
function "/" (Left : Multi_Vector_Type; Right : Multi_Vector_Type) return Multi_Vector_Type is
Fraction : Multi_Vector_Type := Zero_Multivector;
begin
Put_Line ("Function not implemented!"); return Fraction;
end "/";
end Geometric_Algebra_Generic;