|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 15555 (0x3cc3)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
---
package body Matrix_Package is
---
function Transpose (A : Matrix) return Matrix is
B : Matrix (A'First (2) .. A'Last (2), A'First (1) .. A'Last (1));
-- ******************************************************************
-- This function performs the tranpose of input matrix A
-- ******************************************************************
begin
for I in A'Range (2) loop
for J in A'Range (1) loop
B (I, J) := A (J, I);
end loop;
end loop;
return B;
end Transpose;
---
function Transpose (A : Vector) return Vector is
-- *****************************************************************
-- This function returns the transpose of a vector. In programming
-- a vector is always stored as one-dimensional array. Therefore,
-- there is no difference between row vector and column vector.
-- Thus, this function just returns the input vector (do nothing).
-- *****************************************************************
begin
return A;
end Transpose;
---
function "+" (A : Vector; B : Vector) return Vector is
C : Vector (A'First .. A'Last);
-- **************************************************************
-- This function performs the addition of vector A and vector B
-- resulting in a vector. Comparability of dimensions is checked.
-- **************************************************************
begin
if A'First /= B'First or A'Last /= B'Last then
raise Incomparable_Dimension;
end if;
for I in A'Range loop
C (I) := A (I) + B (I);
end loop;
return C;
end "+";
---
function "+" (A : Matrix; B : Matrix) return Matrix is
C : Matrix (A'First (1) .. A'Last (1), A'First (2) .. A'Last (2));
-- *******************************************************************
-- This function performs the addition of matrix A and matrix B
-- resulting in a matrix. Comparability of dimensions is checked.
-- *******************************************************************
begin
if (A'First (1) /= B'First (1) or A'Last (1) /= B'Last (1)) or
(A'First (2) /= B'First (2) or A'Last (2) /= B'Last (2)) then
raise Incomparable_Dimension;
end if;
for I in A'Range (1) loop
for J in A'Range (2) loop
C (I, J) := A (I, J) + B (I, J);
end loop;
end loop;
return C;
end "+";
---
function "-" (A : Vector; B : Vector) return Vector is
C : Vector (A'First .. A'Last);
-- ******************************************************************
-- This function performs the subtraction of vector B from vector A
-- resulting in a vector. Comparability of dimensions is checked.
-- ******************************************************************
begin
if A'First /= B'First or A'Last /= B'Last then
raise Incomparable_Dimension;
end if;
for I in A'Range loop
C (I) := A (I) - B (I);
end loop;
return C;
end "-";
---
function "-" (A : Matrix; B : Matrix) return Matrix is
C : Matrix (A'First (1) .. A'Last (1), A'First (2) .. A'Last (2));
-- ******************************************************************
-- This function performs the subtraction of matrix B from matrix A
-- resulting in a matrix. Comparability of dimensions is checked.
-- ******************************************************************
begin
if (A'First (1) /= B'First (1) or A'Last (1) /= B'Last (1)) or
(A'First (2) /= B'First (2) or A'Last (2) /= B'Last (2)) then
raise Incomparable_Dimension;
end if;
for I in A'Range (1) loop
for J in A'Range (2) loop
C (I, J) := A (I, J) - B (I, J);
end loop;
end loop;
return C;
end "-";
---
function "*" (A : Float; B : Vector) return Vector is
C : Vector (B'First .. B'Last);
-- ******************************************************************
-- This function performs the scalar multiplication of a floating
-- number A and a vector B resulting in a vector.
-- ******************************************************************
begin
for I in B'Range loop
C (I) := A * B (I);
end loop;
return C;
end "*";
---
function "*" (A : Vector; B : Float) return Vector is
begin
-- ********************************************************************
-- This function performs the scalar multiplication of a vector A and
-- a floating number B resulting in a vector.
-- ********************************************************************
return B * A;
end "*";
---
function "*" (A : Vector; B : Vector) return Float is
S : Float := 0.0;
-- *******************************************************************
-- This function performs the inner (dot) product of two vectors A
-- and B resulting in a floating number.
-- Comparability of dimensions is checked.
-- *******************************************************************
begin
if A'First /= B'First or A'Last /= B'Last then
raise Incomparable_Dimension;
end if;
for I in A'Range loop
S := S + A (I) * B (I);
end loop;
return S;
end "*";
---
function "*" (A : Matrix; B : Vector) return Vector is
C : Vector (A'First (1) .. A'Last (1));
Sum : Float;
-- **********************************************************************
-- This function performs the multiplication of a matrix A and a column
-- vector B resulting in a column vector.
-- Comparability of dimensions is checked.
-- **********************************************************************
begin
if A'First (2) /= B'First or A'Last (2) /= B'Last then
raise Incomparable_Dimension;
end if;
for I in A'Range (1) loop
Sum := 0.0;
for K in A'Range (2) loop
Sum := Sum + A (I, K) * B (K);
end loop;
C (I) := Sum;
end loop;
return C;
end "*";
---
function "*" (A : Vector; B : Matrix) return Vector is
C : Vector (B'First (2) .. B'Last (2));
Sum : Float;
-- ********************************************************************
-- This function performs the multiplication of a row vector A and a
-- matrix B resulting in a row vector.
-- Comparability of dimensions is checked.
-- ********************************************************************
begin
if A'First /= B'First (1) or A'Last /= B'Last (1) then
raise Incomparable_Dimension;
end if;
for J in B'Range (2) loop
Sum := 0.0;
for K in A'Range loop
Sum := Sum + A (K) * B (K, J);
end loop;
C (J) := Sum;
end loop;
return C;
end "*";
---
function "*" (A : Float; B : Matrix) return Matrix is
C : Matrix (B'First (1) .. B'Last (1), B'First (2) .. B'Last (2));
-- ********************************************************************
-- This function performs the scalar multipliction of a matrix B by
-- a floating number A resulting in a matrix.
-- ********************************************************************
begin
for I in B'Range (1) loop
for J in B'Range (2) loop
C (I, J) := A * B (I, J);
end loop;
end loop;
return C;
end "*";
---
function "*" (A : Matrix; B : Float) return Matrix is
C : Matrix (A'First (1) .. A'Last (1), A'First (2) .. A'Last (2));
-- *****************************************************************
-- This function performs the scalar multipliction of a matrix A
-- by a floating number B resulting in a matrix.
-- *****************************************************************
begin
return B * A;
end "*";
---
function "*" (A : Matrix; B : Matrix) return Matrix is
C : Matrix (A'First (1) .. A'Last (1), B'First (2) .. B'Last (2));
Sum : Float;
-- ********************************************************************
-- This function performs the multiplication of matrix A and matrix B
-- resulting in a matrix. Comparability of dimensions is checked.
-- ********************************************************************
begin
if A'First (2) /= B'First (1) or A'Last (2) /= B'Last (1) then
raise Incomparable_Dimension;
end if;
for I in A'Range (1) loop
for J in B'Range (2) loop
Sum := 0.0;
for K in A'Range (2) loop
Sum := Sum + A (I, K) * B (K, J);
end loop;
C (I, J) := Sum;
end loop;
end loop;
return C;
end "*";
---
function "**" (A : Matrix; P : Integer) return Matrix is
B, C : Matrix (A'First (1) .. A'Last (1), A'First (1) .. A'Last (1));
I_Pivot, J_Pivot : Integer range A'First (1) .. A'Last (1);
Big_Entry, Temp, Epsilon : Float;
L, M : array (A'Range (1)) of Integer;
-- *******************************************************************
-- This function performs the square matrix operation of " matrix A
-- raise to integer power P ". When P is negative , say P = -N ,
-- A**(-N) = (inverse(A))**N , that is, the inverse of A raise to
-- power N . In this case, matrix A must be non-singular.
-- Exceptions will be raised if the matrix A is not a square matrix,
-- or if matrix A is singular.
-- *******************************************************************
begin
if A'First (1) /= A'First (2) or A'Last (1) /= A'Last (2) then
-- if not a square matrix
raise Incomparable_Dimension;
end if;
if P = 0 then
--& B = identity matrix
for I in A'Range (1) loop
for J in A'Range (1) loop
if I /= J then
B (I, J) := 0.0;
else
B (I, J) := 1.0;
end if;
end loop;
end loop;
return B;
end if;
B := A;
if P > 0 then
--& B = A multiplied itself for P times
for I in 1 .. P - 1 loop
B := B * A;
end loop;
return B;
end if;
-- P is negative, find inverse first
-- initiate the row and column interchange information
for K in B'Range (1) loop
L (K) := K; -- row interchage information
M (K) := K; -- column interchange information
end loop;
-- major loop for inverse
for K in B'Range (1) loop
-- & search for row and column index I_PIVOT, J_PIVOT
-- & both in (K .. B'LAST(1) ) for maximum B(I,J)
-- & in absolute value :BIG_ENTRY
Big_Entry := 0.0;
--
-- check matrix singularity
--
for I in K .. B'Last (1) loop
for J in K .. B'Last (1) loop
if abs (B (I, J)) > abs (Big_Entry) then
Big_Entry := B (I, J);
I_Pivot := I;
J_Pivot := J;
end if;
end loop;
end loop;
if K = B'First (1) then
if Big_Entry = 0.0 then
raise Singular;
else
Epsilon := Float (A'Length (1)) *
abs (Big_Entry) * 0.000001;
end if;
else
if abs (Big_Entry) < Epsilon then
raise Singular;
end if;
end if;
-- interchange row and column
--& interchange K-th and I_PIVOT-th rows
if I_Pivot /= K then
for J in B'Range (1) loop
Temp := B (I_Pivot, J);
B (I_Pivot, J) := B (K, J);
B (K, J) := Temp;
end loop;
L (K) := I_Pivot;
end if;
--& interchange K-th and J_PIVOT-th columns
if J_Pivot /= K then
for I in B'Range (1) loop
Temp := B (I, J_Pivot);
B (I, J_Pivot) := B (I, K);
B (I, K) := Temp;
end loop;
M (K) := J_Pivot;
end if;
--& divide K-th column by minus pivot (-BIG_ENTRY)
for I in B'Range (1) loop
if I /= K then
B (I, K) := B (I, K) / (-Big_Entry);
end if;
end loop;
-- reduce matrix row by row
for I in B'Range (1) loop
if I /= K then
for J in B'Range (1) loop
if J /= K then
B (I, J) := B (I, J) + B (I, K) * B (K, J);
end if;
end loop;
end if;
end loop;
--& divide K-th row by pivot
for J in B'Range (1) loop
if J /= K then
B (K, J) := B (K, J) / Big_Entry;
end if;
end loop;
B (K, K) := 1.0 / Big_Entry;
end loop; -- end of major inverse loop
-- final column and row interchange to obtain
-- inverse of A, i.e. A**(-1)
for K in reverse B'Range (1) loop
-- column interchage
J_Pivot := L (K);
if J_Pivot /= K then
--& intechange B(I,J_PIVOT) and B(I,K) for each row I
for I in B'Range (1) loop
Temp := B (I, J_Pivot);
B (I, J_Pivot) := B (I, K);
B (I, K) := Temp;
end loop;
end if;
-- row interchage
I_Pivot := M (K);
if I_Pivot /= K then
--& INTECHANGE B(I_PIVOT,J) and B(K,J) for each column J
for J in B'Range (1) loop
Temp := B (I_Pivot, J);
B (I_Pivot, J) := B (K, J);
B (K, J) := Temp;
end loop;
end if;
end loop;
-- inverse of A is obtained and stored in B
-- now ready to handle the negative power
-- & C = B**(-P)
if P = -1 then
return B;
end if;
C := B;
for I in P + 1 .. -1 loop
C := C * B;
end loop;
return C;
end "**";
---
end Matrix_Package;