===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2006-2016, 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- --
@@ -337,10 +337,11 @@
Result_Matrix => Real_Matrix,
Operation => "abs");
- function Solve is
- new Matrix_Vector_Solution (Real'Base, Real_Vector, Real_Matrix);
+ function Solve is new
+ Matrix_Vector_Solution (Real'Base, 0.0, Real_Vector, Real_Matrix);
- function Solve is new Matrix_Matrix_Solution (Real'Base, Real_Matrix);
+ function Solve is new
+ Matrix_Matrix_Solution (Real'Base, 0.0, Real_Matrix);
function Unit_Matrix is new
Generic_Array_Operations.Unit_Matrix
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2006-2016, 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- --
@@ -30,9 +30,7 @@
------------------------------------------------------------------------------
with Ada.Numerics; use Ada.Numerics;
-
package body System.Generic_Array_Operations is
-
function Check_Unit_Last
(Index : Integer;
Order : Positive;
@@ -696,6 +694,11 @@
end loop;
Forward_Eliminate (MA, MX, Det);
+
+ if Det = Zero then
+ raise Constraint_Error with "matrix is singular";
+ end if;
+
Back_Substitute (MA, MX);
for J in 0 .. R'Length - 1 loop
@@ -735,6 +738,11 @@
end loop;
Forward_Eliminate (MA, MB, Det);
+
+ if Det = Zero then
+ raise Constraint_Error with "matrix is singular";
+ end if;
+
Back_Substitute (MA, MB);
return MB;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2006-2016, 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- --
@@ -396,6 +396,7 @@
generic
type Scalar is private;
+ Zero : Scalar;
type Vector is array (Integer range <>) of Scalar;
type Matrix is array (Integer range <>, Integer range <>) of Scalar;
with procedure Back_Substitute (M, N : in out Matrix) is <>;
@@ -411,6 +412,7 @@
generic
type Scalar is private;
+ Zero : Scalar;
type Matrix is array (Integer range <>, Integer range <>) of Scalar;
with procedure Back_Substitute (M, N : in out Matrix) is <>;
with procedure Forward_Eliminate
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2006-2016, 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- --
@@ -30,7 +30,6 @@
------------------------------------------------------------------------------
with System.Generic_Array_Operations; use System.Generic_Array_Operations;
-with Ada.Numerics; use Ada.Numerics;
package body Ada.Numerics.Generic_Complex_Arrays is
@@ -694,11 +693,11 @@
-- Solve --
-----------
- function Solve is
- new Matrix_Vector_Solution (Complex, Complex_Vector, Complex_Matrix);
+ function Solve is new Matrix_Vector_Solution
+ (Complex, (0.0, 0.0), Complex_Vector, Complex_Matrix);
- function Solve is
- new Matrix_Matrix_Solution (Complex, Complex_Matrix);
+ function Solve is new Matrix_Matrix_Solution
+ (Complex, (0.0, 0.0), Complex_Matrix);
-----------------
-- Unit_Matrix --
This patch detects cases when the determinant of a system of equations is exactly Zero, and raises the proper exception, as mandated by RN G.3.2 (68/2) and G.3.2 (89/2). Executing the following: gnatmake -q debug_solve.adb debug_solve must yield: System is: 1.00000E+00 x_1 + 0.00000E+00 x_2 + 1.00000E+00 x_3 = 1.00000E+00 2.00000E+00 x_1 + 0.00000E+00 x_2 + 2.00000E+00 x_3 = 2.00000E+00 3.00000E+00 x_1 + 0.00000E+00 x_2 + 1.00000E+00 x_3 = 2.00000E+00 System is: raised CONSTRAINT_ERROR : debug_solve.float_arrays.Instantiations.Solve: matrix is singular --- with Ada.Numerics.Generic_Real_Arrays; with Ada.Text_IO; procedure debug_solve is package float_arrays is new Ada.Numerics.Generic_Real_Arrays (Real => Float); matrix : constant float_arrays.Real_Matrix (1 .. 3, 1 .. 3) := ((1.0, 0.0, 1.0), (2.0, 0.0, 2.0), (3.0, 0.0, 1.0)); rhs : constant float_arrays.Real_Vector (1 .. 3) := (1.0, 2.0, 2.0); solution : float_arrays.Real_Vector (1 .. 3); begin Ada.Text_IO.Put_Line ("System is:"); Ada.Text_IO.Put_Line (Float'Image (matrix (1, 1)) & " x_1 + " & Float'Image (matrix (1, 2)) & " x_2 + " & Float'Image (matrix (1, 3)) & " x_3 = " & Float'Image(rhs(1))); Ada.Text_IO.Put_Line (Float'Image (matrix (2, 1)) & " x_1 + " & Float'Image (matrix (2, 2)) & " x_2 + " & Float'Image (matrix (2, 3)) & " x_3 = " & Float'Image(rhs(2))); Ada.Text_IO.Put_Line (Float'Image (matrix (3, 1)) & " x_1 + " & Float'Image (matrix (3, 2)) & " x_2 + " & Float'Image (matrix (3, 3)) & " x_3 = " & Float'Image(rhs(3))); Ada.Text_IO.Put_Line ("System is:"); solution := float_arrays.Solve (A => matrix, X => rhs); Ada.Text_IO.Put_Line ("Solution is x = (" & Float'Image (solution (1)) & ", " & Float'Image (solution (2)) & ", " & Float'Image (solution (3)) & ")"); end; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-27 Ed Schonberg <schonberg@adacore.com> * s-gearop.ads (Matrix_Vector_Solution, Matrix_Matrix_Solution): Add scalar formal object Zero, to allow detection and report when the matrix is singular. * s-gearop.adb (Matrix_Vector_Solution, Matrix_Matrix_Solution): Raise Constraint_Error if the Forward_Eliminate pass has determined that determinant is Zero.o * s-ngrear.adb (Solve): Add actual for Zero in corresponding instantiations. * s-ngcoar.adb (Solve): Ditto.