| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- ADA.NUMERICS.GENERIC_COMPLEX_ARRAYS -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2006-2012, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with System.Generic_Array_Operations; use System.Generic_Array_Operations; |
| with Ada.Numerics; use Ada.Numerics; |
| |
| package body Ada.Numerics.Generic_Complex_Arrays is |
| |
| -- Operations that are defined in terms of operations on the type Real, |
| -- such as addition, subtraction and scaling, are computed in the canonical |
| -- way looping over all elements. |
| |
| package Ops renames System.Generic_Array_Operations; |
| |
| subtype Real is Real_Arrays.Real; |
| -- Work around visibility bug ??? |
| |
| function Is_Non_Zero (X : Complex) return Boolean is (X /= (0.0, 0.0)); |
| -- Needed by Back_Substitute |
| |
| procedure Back_Substitute is new Ops.Back_Substitute |
| (Scalar => Complex, |
| Matrix => Complex_Matrix, |
| Is_Non_Zero => Is_Non_Zero); |
| |
| procedure Forward_Eliminate is new Ops.Forward_Eliminate |
| (Scalar => Complex, |
| Real => Real'Base, |
| Matrix => Complex_Matrix, |
| Zero => (0.0, 0.0), |
| One => (1.0, 0.0)); |
| |
| procedure Transpose is new Ops.Transpose |
| (Scalar => Complex, |
| Matrix => Complex_Matrix); |
| |
| -- Helper function that raises a Constraint_Error is the argument is |
| -- not a square matrix, and otherwise returns its length. |
| |
| function Length is new Square_Matrix_Length (Complex, Complex_Matrix); |
| |
| -- Instant a generic square root implementation here, in order to avoid |
| -- instantiating a complete copy of Generic_Elementary_Functions. |
| -- Speed of the square root is not a big concern here. |
| |
| function Sqrt is new Ops.Sqrt (Real'Base); |
| |
| -- Instantiating the following subprograms directly would lead to |
| -- name clashes, so use a local package. |
| |
| package Instantiations is |
| |
| --------- |
| -- "*" -- |
| --------- |
| |
| function "*" is new Vector_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "*"); |
| |
| function "*" is new Vector_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "*"); |
| |
| function "*" is new Scalar_Vector_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "*"); |
| |
| function "*" is new Scalar_Vector_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "*"); |
| |
| function "*" is new Inner_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Real_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Inner_Product |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Inner_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Outer_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Complex_Vector, |
| Matrix => Complex_Matrix); |
| |
| function "*" is new Outer_Product |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Complex_Vector, |
| Matrix => Complex_Matrix); |
| |
| function "*" is new Outer_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Real_Vector, |
| Matrix => Complex_Matrix); |
| |
| function "*" is new Matrix_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "*"); |
| |
| function "*" is new Matrix_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "*"); |
| |
| function "*" is new Scalar_Matrix_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "*"); |
| |
| function "*" is new Scalar_Matrix_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "*"); |
| |
| function "*" is new Matrix_Vector_Product |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Matrix => Real_Matrix, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Matrix_Vector_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Matrix => Complex_Matrix, |
| Right_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Matrix_Vector_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Matrix => Complex_Matrix, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Vector_Matrix_Product |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Matrix => Complex_Matrix, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Vector_Matrix_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Matrix => Real_Matrix, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Vector_Matrix_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Matrix => Complex_Matrix, |
| Result_Vector => Complex_Vector, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Matrix_Matrix_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Matrix_Matrix_Product |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Real_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Zero => (0.0, 0.0)); |
| |
| function "*" is new Matrix_Matrix_Product |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Zero => (0.0, 0.0)); |
| |
| --------- |
| -- "+" -- |
| --------- |
| |
| function "+" is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "+"); |
| |
| function "+" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "+"); |
| |
| function "+" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "+"); |
| |
| function "+" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "+"); |
| |
| function "+" is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "+"); |
| |
| function "+" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "+"); |
| |
| function "+" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Real_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "+"); |
| |
| function "+" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "+"); |
| |
| --------- |
| -- "-" -- |
| --------- |
| |
| function "-" is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "-"); |
| |
| function "-" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "-"); |
| |
| function "-" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "-"); |
| |
| function "-" is new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Right_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "-"); |
| |
| function "-" is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "-"); |
| |
| function "-" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "-"); |
| |
| function "-" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Real_Matrix, |
| Right_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "-"); |
| |
| function "-" is new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Right_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "-"); |
| |
| --------- |
| -- "/" -- |
| --------- |
| |
| function "/" is new Vector_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "/"); |
| |
| function "/" is new Vector_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => "/"); |
| |
| function "/" is new Matrix_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Complex, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "/"); |
| |
| function "/" is new Matrix_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => "/"); |
| |
| ----------- |
| -- "abs" -- |
| ----------- |
| |
| function "abs" is new L2_Norm |
| (X_Scalar => Complex, |
| Result_Real => Real'Base, |
| X_Vector => Complex_Vector); |
| |
| -------------- |
| -- Argument -- |
| -------------- |
| |
| function Argument is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Result_Vector => Real_Vector, |
| Operation => Argument); |
| |
| function Argument is new Vector_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Real'Base, |
| Left_Vector => Complex_Vector, |
| Result_Vector => Real_Vector, |
| Operation => Argument); |
| |
| function Argument is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Real_Matrix, |
| Operation => Argument); |
| |
| function Argument is new Matrix_Scalar_Elementwise_Operation |
| (Left_Scalar => Complex, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Real'Base, |
| Left_Matrix => Complex_Matrix, |
| Result_Matrix => Real_Matrix, |
| Operation => Argument); |
| |
| ---------------------------- |
| -- Compose_From_Cartesian -- |
| ---------------------------- |
| |
| function Compose_From_Cartesian is new Vector_Elementwise_Operation |
| (X_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| X_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => Compose_From_Cartesian); |
| |
| function Compose_From_Cartesian is |
| new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => Compose_From_Cartesian); |
| |
| function Compose_From_Cartesian is new Matrix_Elementwise_Operation |
| (X_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| X_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => Compose_From_Cartesian); |
| |
| function Compose_From_Cartesian is |
| new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Real_Matrix, |
| Right_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => Compose_From_Cartesian); |
| |
| ------------------------ |
| -- Compose_From_Polar -- |
| ------------------------ |
| |
| function Compose_From_Polar is |
| new Vector_Vector_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Vector => Real_Vector, |
| Right_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => Compose_From_Polar); |
| |
| function Compose_From_Polar is |
| new Vector_Vector_Scalar_Elementwise_Operation |
| (X_Scalar => Real'Base, |
| Y_Scalar => Real'Base, |
| Z_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| X_Vector => Real_Vector, |
| Y_Vector => Real_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => Compose_From_Polar); |
| |
| function Compose_From_Polar is |
| new Matrix_Matrix_Elementwise_Operation |
| (Left_Scalar => Real'Base, |
| Right_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| Left_Matrix => Real_Matrix, |
| Right_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => Compose_From_Polar); |
| |
| function Compose_From_Polar is |
| new Matrix_Matrix_Scalar_Elementwise_Operation |
| (X_Scalar => Real'Base, |
| Y_Scalar => Real'Base, |
| Z_Scalar => Real'Base, |
| Result_Scalar => Complex, |
| X_Matrix => Real_Matrix, |
| Y_Matrix => Real_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => Compose_From_Polar); |
| |
| --------------- |
| -- Conjugate -- |
| --------------- |
| |
| function Conjugate is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Vector => Complex_Vector, |
| Result_Vector => Complex_Vector, |
| Operation => Conjugate); |
| |
| function Conjugate is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Complex, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Complex_Matrix, |
| Operation => Conjugate); |
| |
| -------- |
| -- Im -- |
| -------- |
| |
| function Im is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Result_Vector => Real_Vector, |
| Operation => Im); |
| |
| function Im is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Real_Matrix, |
| Operation => Im); |
| |
| ------------- |
| -- Modulus -- |
| ------------- |
| |
| function Modulus is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Result_Vector => Real_Vector, |
| Operation => Modulus); |
| |
| function Modulus is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Real_Matrix, |
| Operation => Modulus); |
| |
| -------- |
| -- Re -- |
| -------- |
| |
| function Re is new Vector_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Result_Vector => Real_Vector, |
| Operation => Re); |
| |
| function Re is new Matrix_Elementwise_Operation |
| (X_Scalar => Complex, |
| Result_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Result_Matrix => Real_Matrix, |
| Operation => Re); |
| |
| ------------ |
| -- Set_Im -- |
| ------------ |
| |
| procedure Set_Im is new Update_Vector_With_Vector |
| (X_Scalar => Complex, |
| Y_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Y_Vector => Real_Vector, |
| Update => Set_Im); |
| |
| procedure Set_Im is new Update_Matrix_With_Matrix |
| (X_Scalar => Complex, |
| Y_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Y_Matrix => Real_Matrix, |
| Update => Set_Im); |
| |
| ------------ |
| -- Set_Re -- |
| ------------ |
| |
| procedure Set_Re is new Update_Vector_With_Vector |
| (X_Scalar => Complex, |
| Y_Scalar => Real'Base, |
| X_Vector => Complex_Vector, |
| Y_Vector => Real_Vector, |
| Update => Set_Re); |
| |
| procedure Set_Re is new Update_Matrix_With_Matrix |
| (X_Scalar => Complex, |
| Y_Scalar => Real'Base, |
| X_Matrix => Complex_Matrix, |
| Y_Matrix => Real_Matrix, |
| Update => Set_Re); |
| |
| ----------- |
| -- Solve -- |
| ----------- |
| |
| function Solve is |
| new Matrix_Vector_Solution (Complex, Complex_Vector, Complex_Matrix); |
| |
| function Solve is |
| new Matrix_Matrix_Solution (Complex, Complex_Matrix); |
| |
| ----------------- |
| -- Unit_Matrix -- |
| ----------------- |
| |
| function Unit_Matrix is new System.Generic_Array_Operations.Unit_Matrix |
| (Scalar => Complex, |
| Matrix => Complex_Matrix, |
| Zero => (0.0, 0.0), |
| One => (1.0, 0.0)); |
| |
| function Unit_Vector is new System.Generic_Array_Operations.Unit_Vector |
| (Scalar => Complex, |
| Vector => Complex_Vector, |
| Zero => (0.0, 0.0), |
| One => (1.0, 0.0)); |
| end Instantiations; |
| |
| --------- |
| -- "*" -- |
| --------- |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Complex_Vector) return Complex |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real_Vector; |
| Right : Complex_Vector) return Complex |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Real_Vector) return Complex |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Complex) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real'Base; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Real'Base) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Complex_Vector) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Complex_Matrix) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Real_Matrix) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real_Vector; |
| Right : Complex_Vector) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Real_Vector) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real_Vector; |
| Right : Complex_Matrix) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Vector; |
| Right : Real_Matrix) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real_Matrix; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Real_Vector) return Complex_Vector |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Complex) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Real'Base; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| function "*" |
| (Left : Complex_Matrix; |
| Right : Real'Base) return Complex_Matrix |
| renames Instantiations."*"; |
| |
| --------- |
| -- "+" -- |
| --------- |
| |
| function "+" (Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Complex_Vector; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Real_Vector; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Complex_Vector; |
| Right : Real_Vector) return Complex_Vector |
| renames Instantiations."+"; |
| |
| function "+" (Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Complex_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Real_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."+"; |
| |
| function "+" |
| (Left : Complex_Matrix; |
| Right : Real_Matrix) return Complex_Matrix |
| renames Instantiations."+"; |
| |
| --------- |
| -- "-" -- |
| --------- |
| |
| function "-" |
| (Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Complex_Vector; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Real_Vector; |
| Right : Complex_Vector) return Complex_Vector |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Complex_Vector; |
| Right : Real_Vector) return Complex_Vector |
| renames Instantiations."-"; |
| |
| function "-" (Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Complex_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Real_Matrix; |
| Right : Complex_Matrix) return Complex_Matrix |
| renames Instantiations."-"; |
| |
| function "-" |
| (Left : Complex_Matrix; |
| Right : Real_Matrix) return Complex_Matrix |
| renames Instantiations."-"; |
| |
| --------- |
| -- "/" -- |
| --------- |
| |
| function "/" |
| (Left : Complex_Vector; |
| Right : Complex) return Complex_Vector |
| renames Instantiations."/"; |
| |
| function "/" |
| (Left : Complex_Vector; |
| Right : Real'Base) return Complex_Vector |
| renames Instantiations."/"; |
| |
| function "/" |
| (Left : Complex_Matrix; |
| Right : Complex) return Complex_Matrix |
| renames Instantiations."/"; |
| |
| function "/" |
| (Left : Complex_Matrix; |
| Right : Real'Base) return Complex_Matrix |
| renames Instantiations."/"; |
| |
| ----------- |
| -- "abs" -- |
| ----------- |
| |
| function "abs" (Right : Complex_Vector) return Real'Base |
| renames Instantiations."abs"; |
| |
| -------------- |
| -- Argument -- |
| -------------- |
| |
| function Argument (X : Complex_Vector) return Real_Vector |
| renames Instantiations.Argument; |
| |
| function Argument |
| (X : Complex_Vector; |
| Cycle : Real'Base) return Real_Vector |
| renames Instantiations.Argument; |
| |
| function Argument (X : Complex_Matrix) return Real_Matrix |
| renames Instantiations.Argument; |
| |
| function Argument |
| (X : Complex_Matrix; |
| Cycle : Real'Base) return Real_Matrix |
| renames Instantiations.Argument; |
| |
| ---------------------------- |
| -- Compose_From_Cartesian -- |
| ---------------------------- |
| |
| function Compose_From_Cartesian (Re : Real_Vector) return Complex_Vector |
| renames Instantiations.Compose_From_Cartesian; |
| |
| function Compose_From_Cartesian |
| (Re : Real_Vector; |
| Im : Real_Vector) return Complex_Vector |
| renames Instantiations.Compose_From_Cartesian; |
| |
| function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix |
| renames Instantiations.Compose_From_Cartesian; |
| |
| function Compose_From_Cartesian |
| (Re : Real_Matrix; |
| Im : Real_Matrix) return Complex_Matrix |
| renames Instantiations.Compose_From_Cartesian; |
| |
| ------------------------ |
| -- Compose_From_Polar -- |
| ------------------------ |
| |
| function Compose_From_Polar |
| (Modulus : Real_Vector; |
| Argument : Real_Vector) return Complex_Vector |
| renames Instantiations.Compose_From_Polar; |
| |
| function Compose_From_Polar |
| (Modulus : Real_Vector; |
| Argument : Real_Vector; |
| Cycle : Real'Base) return Complex_Vector |
| renames Instantiations.Compose_From_Polar; |
| |
| function Compose_From_Polar |
| (Modulus : Real_Matrix; |
| Argument : Real_Matrix) return Complex_Matrix |
| renames Instantiations.Compose_From_Polar; |
| |
| function Compose_From_Polar |
| (Modulus : Real_Matrix; |
| Argument : Real_Matrix; |
| Cycle : Real'Base) return Complex_Matrix |
| renames Instantiations.Compose_From_Polar; |
| |
| --------------- |
| -- Conjugate -- |
| --------------- |
| |
| function Conjugate (X : Complex_Vector) return Complex_Vector |
| renames Instantiations.Conjugate; |
| |
| function Conjugate (X : Complex_Matrix) return Complex_Matrix |
| renames Instantiations.Conjugate; |
| |
| ----------------- |
| -- Determinant -- |
| ----------------- |
| |
| function Determinant (A : Complex_Matrix) return Complex is |
| M : Complex_Matrix := A; |
| B : Complex_Matrix (A'Range (1), 1 .. 0); |
| R : Complex; |
| begin |
| Forward_Eliminate (M, B, R); |
| return R; |
| end Determinant; |
| |
| ----------------- |
| -- Eigensystem -- |
| ----------------- |
| |
| procedure Eigensystem |
| (A : Complex_Matrix; |
| Values : out Real_Vector; |
| Vectors : out Complex_Matrix) |
| is |
| N : constant Natural := Length (A); |
| |
| -- For a Hermitian matrix C, we convert the eigenvalue problem to a |
| -- real symmetric one: if C = A + i * B, then the (N, N) complex |
| -- eigenvalue problem: |
| -- (A + i * B) * (u + i * v) = Lambda * (u + i * v) |
| -- |
| -- is equivalent to the (2 * N, 2 * N) real eigenvalue problem: |
| -- [ A, B ] [ u ] = Lambda * [ u ] |
| -- [ -B, A ] [ v ] [ v ] |
| -- |
| -- Note that the (2 * N, 2 * N) matrix above is symmetric, as |
| -- Transpose (A) = A and Transpose (B) = -B if C is Hermitian. |
| |
| -- We solve this eigensystem using the real-valued algorithms. The final |
| -- result will have every eigenvalue twice, so in the sorted output we |
| -- just pick every second value, with associated eigenvector u + i * v. |
| |
| M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); |
| Vals : Real_Vector (1 .. 2 * N); |
| Vecs : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); |
| |
| begin |
| for J in 1 .. N loop |
| for K in 1 .. N loop |
| declare |
| C : constant Complex := |
| (A (A'First (1) + (J - 1), A'First (2) + (K - 1))); |
| begin |
| M (J, K) := Re (C); |
| M (J + N, K + N) := Re (C); |
| M (J + N, K) := Im (C); |
| M (J, K + N) := -Im (C); |
| end; |
| end loop; |
| end loop; |
| |
| Eigensystem (M, Vals, Vecs); |
| |
| for J in 1 .. N loop |
| declare |
| Col : constant Integer := Values'First + (J - 1); |
| begin |
| Values (Col) := Vals (2 * J); |
| |
| for K in 1 .. N loop |
| declare |
| Row : constant Integer := Vectors'First (2) + (K - 1); |
| begin |
| Vectors (Row, Col) |
| := (Vecs (J * 2, Col), Vecs (J * 2, Col + N)); |
| end; |
| end loop; |
| end; |
| end loop; |
| end Eigensystem; |
| |
| ----------------- |
| -- Eigenvalues -- |
| ----------------- |
| |
| function Eigenvalues (A : Complex_Matrix) return Real_Vector is |
| -- See Eigensystem for a description of the algorithm |
| |
| N : constant Natural := Length (A); |
| R : Real_Vector (A'Range (1)); |
| |
| M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); |
| Vals : Real_Vector (1 .. 2 * N); |
| begin |
| for J in 1 .. N loop |
| for K in 1 .. N loop |
| declare |
| C : constant Complex := |
| (A (A'First (1) + (J - 1), A'First (2) + (K - 1))); |
| begin |
| M (J, K) := Re (C); |
| M (J + N, K + N) := Re (C); |
| M (J + N, K) := Im (C); |
| M (J, K + N) := -Im (C); |
| end; |
| end loop; |
| end loop; |
| |
| Vals := Eigenvalues (M); |
| |
| for J in 1 .. N loop |
| R (A'First (1) + (J - 1)) := Vals (2 * J); |
| end loop; |
| |
| return R; |
| end Eigenvalues; |
| |
| -------- |
| -- Im -- |
| -------- |
| |
| function Im (X : Complex_Vector) return Real_Vector |
| renames Instantiations.Im; |
| |
| function Im (X : Complex_Matrix) return Real_Matrix |
| renames Instantiations.Im; |
| |
| ------------- |
| -- Inverse -- |
| ------------- |
| |
| function Inverse (A : Complex_Matrix) return Complex_Matrix is |
| (Solve (A, Unit_Matrix (Length (A)))); |
| |
| ------------- |
| -- Modulus -- |
| ------------- |
| |
| function Modulus (X : Complex_Vector) return Real_Vector |
| renames Instantiations.Modulus; |
| |
| function Modulus (X : Complex_Matrix) return Real_Matrix |
| renames Instantiations.Modulus; |
| |
| -------- |
| -- Re -- |
| -------- |
| |
| function Re (X : Complex_Vector) return Real_Vector |
| renames Instantiations.Re; |
| |
| function Re (X : Complex_Matrix) return Real_Matrix |
| renames Instantiations.Re; |
| |
| ------------ |
| -- Set_Im -- |
| ------------ |
| |
| procedure Set_Im |
| (X : in out Complex_Matrix; |
| Im : Real_Matrix) |
| renames Instantiations.Set_Im; |
| |
| procedure Set_Im |
| (X : in out Complex_Vector; |
| Im : Real_Vector) |
| renames Instantiations.Set_Im; |
| |
| ------------ |
| -- Set_Re -- |
| ------------ |
| |
| procedure Set_Re |
| (X : in out Complex_Matrix; |
| Re : Real_Matrix) |
| renames Instantiations.Set_Re; |
| |
| procedure Set_Re |
| (X : in out Complex_Vector; |
| Re : Real_Vector) |
| renames Instantiations.Set_Re; |
| |
| ----------- |
| -- Solve -- |
| ----------- |
| |
| function Solve |
| (A : Complex_Matrix; |
| X : Complex_Vector) return Complex_Vector |
| renames Instantiations.Solve; |
| |
| function Solve |
| (A : Complex_Matrix; |
| X : Complex_Matrix) return Complex_Matrix |
| renames Instantiations.Solve; |
| |
| --------------- |
| -- Transpose -- |
| --------------- |
| |
| function Transpose |
| (X : Complex_Matrix) return Complex_Matrix |
| is |
| R : Complex_Matrix (X'Range (2), X'Range (1)); |
| begin |
| Transpose (X, R); |
| return R; |
| end Transpose; |
| |
| ----------------- |
| -- Unit_Matrix -- |
| ----------------- |
| |
| function Unit_Matrix |
| (Order : Positive; |
| First_1 : Integer := 1; |
| First_2 : Integer := 1) return Complex_Matrix |
| renames Instantiations.Unit_Matrix; |
| |
| ----------------- |
| -- Unit_Vector -- |
| ----------------- |
| |
| function Unit_Vector |
| (Index : Integer; |
| Order : Positive; |
| First : Integer := 1) return Complex_Vector |
| renames Instantiations.Unit_Vector; |
| |
| end Ada.Numerics.Generic_Complex_Arrays; |
