Clas1.dcl                                                                                           0100644 0011162 0011134 00000002456 06644674725 0013115 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

definition module Clas1

import SampleVec, StdBool

dot  :: .Vector .Vector -> Real				//	x^T y

nrm1   :: Vector -> Real					//	||x||_1
nrm2   :: Vector -> Real					//	||x||_2
nrmInf :: Vector -> Real					//	||x||_inf

amax :: Vector -> Int						//  {k : max_j |x_j|}
											//	||x||_inf=|x_k|

											//  Givens rotation:
											//  [ c -s ] [ a ] = [ r ]
											//  [ s  c ] [ b ]   [ 0 ]
rotg :: Real Real -> (Real, Real)    		//  a b -> (c, s)
											//  applied Givens rotation
rot :: Real Real -> (Real, Real)    		//  a b -> (r, 0)
  

instance + {# a} | + , ArrayElem a
instance - {# a} | - , ArrayElem a
instance * {# a} | * , ArrayElem a			// Hadamard product
instance / {# a} | / , ArrayElem a			// Hadamard division

class ScalarProduct a
where
	(.*) infix 7 :: Real a -> a

instance ScalarProduct Real
instance ScalarProduct {# a} | ScalarProduct , ArrayElem a


class ScalarDivision a
where
	(/.) infix 7 :: a Real -> a

instance ScalarDivision Real
instance ScalarDivision {# a} | ScalarDivision , ArrayElem a
                                                                                                                                                                                                                  Clas1.icl                                                                                           0100644 0011162 0011134 00000004517 06644674726 0013123 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

implementation module Clas1

import SampleVec, StdBool

dot :: .Vector .Vector -> Real
dot x y = dot_i 0
where
	n = size x
	m = size y
	dot_i :: Int -> Real
	dot_i i | (i==n) || (i==m) = 0.0
	dot_i i = (x.[i] * y.[i]) + dot_i (inc i)   
	
nrm1 :: Vector -> Real
nrm1 x = nrm1_i 0
where
	n = size x
	nrm1_i :: Int -> Real
	nrm1_i i | (i==n) = 0.0
	nrm1_i i = (abs x.[i]) + nrm1_i (inc i)
	
nrm2 :: Vector -> Real
nrm2 x = sqrt (dot x x)

nrmInf :: Vector -> Real
nrmInf x = nrmInf_i 0 0.0
where
	n = size x
    nrmInf_i :: Int Real -> Real
    nrmInf_i i max 
        | (i==n) = max
        | (abs x.[i]) > max = nrmInf_i (inc i) (abs x.[i]) 
        = nrmInf_i (inc i) max

amax :: Vector -> Int
amax x = amax_ 1 0
where
	amax_ :: Int Int -> Int
	amax_ ind max | (ind==(size x)) = inc max
	amax_ ind max | ((abs x.[ind])>(abs x.[max])) = amax_ (inc ind) ind
	amax_ ind max = amax_ (inc ind) max

rotg :: Real Real -> (Real, Real)    // (a,b) -> (c,s)
rotg a 0.0 = (0.0, 1.0) 
rotg a b | ((abs b)>(abs a)) = (s * tau, s) 
where 
	tau=(~a)/b 
	s=1.0 / (sqrt (1.0 + (tau * tau)))
rotg a b = (c, c * tau) 
where 
	tau=(~b)/a
	c=1.0 / (sqrt (1.0 + (tau * tau)))
  
rot :: Real Real -> (Real, Real)    // (a,b) -> (r,0)
rot a b = ( (c*a)-(s*b), (s*a)+(c*b))
where
	(c,s) = rotg a b


instance + {# a} | + , ArrayElem a
where 
	(+) a b = { aa + bb \\ aa <-: a & bb <-: b}

instance - {# a} | - , ArrayElem a
where 
	(-) a b = { aa - bb \\ aa <-: a & bb <-: b}

instance * {# a} | *, ArrayElem a		// Hadamard product
where
	(*) a b = { aa * bb \\ aa <-: a & bb <-: b}
	
instance / {# a} | /, ArrayElem a		// Hadamard division
where
	(/) a b = { aa / bb \\ aa <-: a & bb <-: b}
	
class ScalarProduct a
where
	(.*) infix 7 :: Real a -> a

instance ScalarProduct Real
where	
	(.*) a x = a * x

instance ScalarProduct {# a} | ScalarProduct , ArrayElem a
where	
	(.*) a x = { a .* xx \\ xx <-: x}
	
class ScalarDivision a
where
	(/.) infix 7 :: a Real -> a

instance ScalarDivision Real
where	
	(/.) x a = x / a

instance ScalarDivision {# a} | ScalarDivision , ArrayElem a
where	
	(/.) x a = { xx /. a \\ xx <-: x}
                                                                                                                                                                                 Clas2.dcl                                                                                           0100644 0011162 0011134 00000001632 06644674726 0013112 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

definition module Clas2

import Clas1, SampleMat, StdMisc

class MatrixVectorProduct a
where
	(**) infix 7 :: a Vector -> Vector
	
instance MatrixVectorProduct {#{# Real}}

transpose 		:: .Matrix -> .Matrix

forwardSubst 	:: Matrix Vector -> *Vector	// Solve a system
											// with a lower left
											// triangular system 
backwardSubst 	:: Matrix Vector -> *Vector	// Solve a system
											// with a upper right
											// triangular system *)
// use with LU factorization Ax=LUx=b <==> Ly=b, Ux=y
// cf. solve in Clas3

// *)	assuming that only ones are on the diagonal, which is the case 
//		after the LU factorization


                                                                                                      Clas2.icl                                                                                           0100644 0011162 0011134 00000002627 06644674726 0013124 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

implementation module Clas2

import Clas1, SampleMat, StdMisc

class MatrixVectorProduct a
where
	(**) infix 7 :: a Vector -> Vector
	
instance MatrixVectorProduct {#{# Real}}
where
	(**) a x = { dot aa x \\ aa <-: a}

transpose :: .Matrix -> .Matrix
transpose a = transpose_i 0 (zeroMatrix m n)
where
	n = size a
	m = size a.[0]
	transpose_i :: Int *Matrix -> *Matrix
	transpose_i i b
		| (i==m) = b
		= transpose_i (inc i) { b & [i] = { a.[j,i] \\ j <- [0 .. (dec n)]}}  

forwardSubst :: Matrix Vector -> *Vector
forwardSubst l b = forwardSubst_ 1 { zeros n & [0] = b.[0] / l.[0, 0]}
where
	n = size l
	forwardSubst_ :: Int *Vector -> *Vector
	forwardSubst_ i y
		#! dotly = dot l.[i] y
		| (i==dec n) = { y & [i] = b.[i] - dotly }
		= forwardSubst_ (inc i) { y & [i] = b.[i] - dotly }

backwardSubst :: Matrix Vector -> *Vector
backwardSubst u y = backwardSubst_ (n-2) { zeros n & [dec n] = (y.[dec n] / u.[dec n, dec n]) }
where
	n = size u
	backwardSubst_ :: Int *Vector -> *Vector
	backwardSubst_ i x 
		#! dotux = dot u.[i] x
		| (i==0) = {x & [i] = (y.[i] - dotux) / u.[i,i]}
		= backwardSubst_ (dec i) {x & [i] = (y.[i] - dotux) / u.[i,i]}

                                                                                                         Clas3.dcl                                                                                           0100644 0011162 0011134 00000001676 06644674726 0013123 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

definition module Clas3

import Clas2

class MatrixMatrixProduct a
where
	(***) infix 7 :: a a -> a

instance MatrixMatrixProduct {#{# Real}}

solve 	:: *Matrix Vector -> Vector

lu 		:: *Matrix -> *Matrix		// LU factorization A=LU
// overwrites the input matrix A with both factors L and U:
//		l_11  u_12   ..      ..       u_1n
//		 ..   l_22  u_23     ..        ..
//       ..    ..    ..      ..        ..
//       ..    ..    ..      ..     u_(n-1)n 
//      l_n1  l_n2   ..   l_n(n-1)    l_nn
// The diagonal u_ii, i=1,...,n of U is constant 1 by construction.

invert 	:: *Matrix -> .Matrix		// invert matrix by means of
									// the Gauss-Jordan algorithm
									
                                                                  Clas3.icl                                                                                           0100644 0011162 0011134 00000004011 06644674727 0013113 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

implementation module Clas3

import Clas2

class MatrixMatrixProduct a
where
	(***) infix 7 :: a a -> a

instance MatrixMatrixProduct {#{# Real}}
where
 	(***) a b 
 		| (size a.[0]) <> (size b) 
 			= abort "\n(***): matrix dimensions do not match!" 
 		= { a ** bb \\ bb <-: (transpose b)}
	
solve :: *Matrix Vector -> Vector
solve a b
	# lu = lu a
	# y = forwardSubst lu b
	= backwardSubst lu y

lu :: *Matrix -> *Matrix
lu aa = lu_k 0 a
where
	(n, a) = usize aa
	lu_k :: Int *Matrix -> *Matrix
	lu_k k a 
		| k>(n-2) = a
		= lu_i (inc k) a
	where
		lu_i :: Int *Matrix -> *Matrix
		lu_i i a
			| i>(n-1) = lu_k (inc k) a
		lu_i i a =: {[k, k] = akk, [i, k] = aik}			
			| (akk==0.0) = abort "matrix is singular!"
			= lu_j (inc k) { a & [i,k] = aik / akk}
		where
			lu_j :: Int *Matrix -> *Matrix
			lu_j j a
				| j>(n-1) = lu_i (inc i) a
			lu_j j a =: { [i, j] = aij, [i, k] = aik, [k, j] = akj}
				= lu_j (inc j) { a & [i,j] = aij - aik * akj}

invert :: *Matrix -> .Matrix
invert aa = inv_j 0 a
where
	(n, a) = usize aa
	inv_j :: Int *Matrix -> *Matrix
	inv_j j a 
		| j>(n-1) = a
		= inv_i 0 a
	where
		inv_i :: Int *Matrix -> *Matrix
		inv_i i a =: { [j, j] = ajj}
			| i>(n-1) = inv_k 0 { a & [j, j] = 1.0 / ajj}
			| (i==j) = inv_i (inc i) a
			#! (aij, a) = a![i, j]
			= inv_i (inc i) { a & [i, j] = aij / ajj}
		where
			inv_k :: Int *Matrix -> *Matrix
			inv_k k a
				| k>(n-1) = inv_j (inc j) a
				| (k==j) = inv_k (inc k) a
				= inv_l 0 a
			where
				inv_l :: Int *Matrix -> *Matrix
				inv_l l a
					#! (ajj, a) = a![j, j]
					#! (ajk, a) = a![j, k]
					| l>(n-1) = inv_k (inc k) { a & [j, k] = ~(ajk * ajj)}
					| (l==j) = inv_l (inc l) a
					#! (alk, a) = a![l, k]
					#! (alj, a) = a![l, j]
				= inv_l (inc l) { a & [l, k] = alk - alj * ajk}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       SampleMat.dcl                                                                                       0100644 0011162 0011134 00000000773 06644674727 0014037 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

definition module SampleMat

import SampleVec, StdTuple

:: Matrix :== {#.Vector}

uniMat :: .Matrix -> *Matrix

zeroMatrix :: Int Int -> .Matrix
In :: Int -> .Matrix
hilbert :: Int -> .Matrix

prettyMatrix :: Matrix -> String
     SampleMat.icl                                                                                       0100644 0011162 0011134 00000001720 06644674727 0014035 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

implementation module SampleMat

import SampleVec

:: Matrix :== {#.Vector}

uniMat :: .Matrix -> *Matrix
uniMat a = { { aaa \\ aaa <-: aa} \\ aa <-: a}

zeroMatrix :: Int Int -> .Matrix
zeroMatrix n m = { zeros m \\ i <- [1 .. n]}

In :: Int -> .Matrix
In n = { ek k n \\ k <- [0 .. dec n]}

hilbert :: Int -> .Matrix
hilbert n = { { 1.0 / toReal (i+j-1) \\ i <- [1 .. n]} \\ j <- [1 .. n]}

// ----------------------------------------------------------------------------

prettyMatrix :: Matrix -> String
prettyMatrix a = "\n" +++ (prettyMatrix_i 0)
where
	n = size a
	prettyMatrix_i :: Int -> String
	prettyMatrix_i i 
		| (i==n) = "\n"
		= (prettyRowVector a.[i]) +++ (prettyMatrix_i (inc i))                                                SampleVec.dcl                                                                                       0100644 0011162 0011134 00000001161 06644674727 0014023 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

definition module SampleVec

import StdArray, StdEnum, StdList, StdReal, StdString

:: Vector	:== {# Real}			// A vector is an array of reals

uniVec :: .Vector -> *Vector

zeros :: Int -> .Vector
ones  :: Int -> .Vector
one2n :: Int -> .Vector
ek :: Int Int -> .Vector

prettyRowVector :: Vector -> String
prettyColumnVector :: Vector -> String                                                                                                                                                                                                                                                                                                                                                                                                               SampleVec.icl                                                                                       0100644 0011162 0011134 00000002241 06644674727 0014030 0                                                                                                    ustar 00zoerner                         psb                             0000243 0001472                                                                                                                                                                        // ************************************************************
//	Clean Linear Algebra Subroutines - CLAS
//	Version 0.5 - October 6, 1998 - Thorsten Zoerner
// 	Catholic University of Nijmegen - zoerner@cs.kun.nl
// ************************************************************

implementation module SampleVec

import StdArray, StdEnum, StdList, StdReal, StdString

:: Vector		:== {# Real}

uniVec :: .Vector -> *Vector
uniVec x = { xx \\ xx <-: x}

zeros :: Int -> .Vector
zeros n = createArray n 0.0

ones :: Int -> .Vector
ones n = createArray n 1.0

one2n :: Int -> .Vector
one2n n = {toReal i \\ i <- [1 .. n]}

ek :: Int Int -> .Vector
ek k n = {zeros n & [k] = 1.0}

prettyRowVector :: Vector -> String
prettyRowVector x = "\n" +++ (prettyRowVector_i 0)
where
	n = size x
	prettyRowVector_i :: Int -> String
	prettyRowVector_i i 
		| (i==n) = "\n"
		= (toString x.[i]) +++ "\t\t" +++ (prettyRowVector_i (inc i))
  
prettyColumnVector :: Vector -> String
prettyColumnVector x = "\n" +++ (prettyColumnVector_i 0)
where
	n = size x
	prettyColumnVector_i :: Int -> String
	prettyColumnVector_i i 
		| (i==n) = "\n"
		= (toString x.[i]) +++ "\n" +++ (prettyColumnVector_i (inc i))
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               