vec.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
partial class VEC{ET < $REAL{ET}}
partial class VEC{ET < $REAL{ET}} is
-- This partial class specifies most of the vector operations. It is,
-- however, incomplete, requiring a VECTOR_LENGTH_MIXIN class for full
-- instantiation. A vector is defined as a target space for a linear
-- operator -- this is NOT the same sort of thing as an array!
-- This is a pure Sather implementation of the basic vector class.
-- "length" and dot product operations will NOT be implemented here, but in
-- auxiliary 'partial' (non-instantiable) classes that are designed solely
-- or implementation inheritance.
-- A concrete vector class of floating point numbers then would inherit
-- from this class, and the auxiliary 'length' implementation suitable for
-- it, and then subtype from the proper generics. Finally, for some element
-- types, such as floating point numbers, there will be implementations that
-- may over-ride some of the implementations in this class and replace them
-- with BLAS calls.
-- Version 1.1 Sep 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 13 Jul 96 mbk Original for Sather 1.1 Dist
-- 4 Sep 97 kh Modified for CARD/portability.
-- 22 Mar 01 djw major rewrite
include AREF{ET} ;
create(
sz : CARD
) : SAME is
-- This creation routine returns a new vector of the given size.
me : SAME := new(sz) ;
return me
end ;
create(
val : SAME
) : SAME
pre ~void(val) is
-- This routine returns a new vector of the same size as val.
me : SAME := new(val.asize) ;
return me
end ;
create(
val : ARRAY{ET}
) : SAME
pre ~void(val) is
-- This routine returns a new vector of the same size as val and
-- containing the elements of val in order.
me : SAME := new(val.asize) ;
loop
me.aset!(val.elt!)
end ;
return me
end ;
element_zero : ET is
-- This routine returns an element value of zero.
return ET::zero
end ;
element_one : ET is
-- This orutine returns an element value of unity.
return ET::one
end ;
dim : CARD is
-- This routine is a synonym for asize.
return asize
end ;
copy : SAME
pre ~void(self) is
-- This routine returns a new vector which is an exact copy of self.
res : SAME := create(asize) ;
res.acopy(self) ;
return res
end ;
array : ARRAY{ET}
pre ~void(self) is
-- This routine returns an array of elements which contains the same
-- values as self.
res : ARRAY{ET} := ARRAY{ET}::create(dim) ;
loop
res.set!(aelt!)
end
end ;
same_size(
other : SAME
) : BOOL is
-- This routine returns true if and only if self and other are vectors
-- of the same size.
if void(other)
or void(self) then
return false
elsif other.asize /= asize then
return false
else
return true
end
end ;
is_eq(
other : SAME
) : BOOL
pre same_size(other) is
-- This routne returns true if and only if self and other have the same
-- contents.
loop
if aelt! /= other.aelt! then
return false
end
end ;
return true
end ;
inplace_contents(
val : SAME
)
pre same_size(val) is
-- This routine sets the contents of self to be a copy of val.
self.acopy(val)
end ;
inplace_contents_subspace(
destbeg : CARD,
cnt : CARD,
srcbeg : CARD,
val : SAME
)
pre ~void(self)
and ~void(val)
and (destbeg <= (asize - 1))
and (cnt <= (asize - destbeg))
and (cnt <= (val.asize - srcbeg)) is
-- This routine sets the cnt elements of self beginning with destbeg to
-- have the same values as the cnt elements of val beginning at srcbeg.
acopy(destbeg,cnt,srcbeg,val)
end ;
inplace_contents_from_function(
function : ROUT{CARD} : ET
)
pre ~void(self) is
-- This routine sets the contents of self to be the result of applying
-- the given function to the element index values in turn.
loop
index : CARD := asize.times! ;
[index] := function.call(index)
end
end ;
inplace_elements(
val : ET
)
pre ~void(self) is
-- This routine sets all of the elements of self to have the given value.
loop
aset!(val)
end
end ;
inplace_unit_vector(
num : CARD
)
pre ~void(self)
and (num <= (asize - 1)) is
-- This routine sets self to be the unit vector.
loop
index : CARD := asize.times! ;
if index = num then
[num] := element_one
else
[index] := element_zero
end
end
end ;
inplace_swapped(
other : SAME
)
pre same_size(other) is
-- This routine swaps the values of self and other element by element.
loop
index : CARD := asize.times! ;
tmp : ET := [index] ;
[index] := other[index] ;
other[index] := tmp
end
end ;
inplace_arg_plus_scaled_arg(
arg1 : SAME,
scale : ET,
arg2 : SAME
)
pre same_size(arg1)
and arg1.same_size(arg2) is
-- This routine sets self to be the sum of arg1 and the scaled value of
-- arg2, element by element.
loop
index : CARD := asize.times! ;
[index] := arg1[index] + scale * arg2[index]
end
end ;
plus_scaled_arg(
scale : ET,
val : SAME
) : SAME
pre same_size(val) is
-- This routine returns a new vector which is the sum of self and val
-- caled.
res : SAME := new(asize) ;
res.inplace_arg_plus_scaled_arg(self,scale,val) ;
return res
end ;
inplace_plus_scaled_arg(
scale : ET,
val : SAME
)
pre same_size(val) is
-- This routine sets self to be self plus the scaled value of val,
-- element by element.
loop
index : CARD := asize.times! ;
[index] := [index] + scale * val[index]
end
end ;
inplace_plus_arg(
val : SAME
)
pre same_size(val) is
-- This routine sets self to be the sum of self and val, element by
-- element.
loop
index : CARD := asize.times! ;
[index] := [index] + val[index]
end
end ;
inplace_arg_plus_arg(
arg1,
arg2 : SAME
)
pre same_size(arg1)
and arg1.same_size(arg2) is
-- This routine sets self to be the sum of arg1 and arg2, element by
-- element.
loop
index : CARD := asize.times! ;
[index] := arg1[index] + arg2[index]
end
end ;
plus(
other : SAME
) : SAME is
-- This routine returns the vector which is the sum of self and other,
-- element by element.
res : SAME := new(asize) ;
res.inplace_arg_plus_arg(self,other) ;
return res
end ;
plus_arg(
other : SAME
) : SAME is
-- This routine is a synonym for plus above.
return plus(other)
end ;
inplace_minus_arg(
val : SAME
)
pre same_size(val) is
-- This routine sets self to be the value of self - other, element by
-- element.
loop
index : CARD := asize.times! ;
[index] := [index] - val[index]
end
end ;
inplace_arg_minus_arg(
arg1,
arg2 : SAME
)
pre same_size(arg1)
and arg1.same_size(arg2) is
-- This routine sets self to be the difference obtained by subtracting
-- arg2 from arg1, element by element.
loop
index : CARD := asize.times! ;
[index] := arg1[index] - arg2[index]
end
end ;
minus(
other : SAME
) : SAME is
-- This routine returns a new vector which is the difference between
-- self and other.
res : SAME := new(asize) ;
res.inplace_arg_minus_arg(self,other) ;
return res
end ;
minus_arg(
other : SAME
) : SAME is
-- This routine is a synonym for minus above.
return minus(other)
end ;
times(
scale : ET
) : SAME
pre ~void(self) is
-- This routine returns a new vector the values of all of he elements of
-- which are scale times that of the corresponding element of self.
res : SAME := new(asize) ;
loop
index : CARD := asize.times! ;
res[index] := [index] * scale
end ;
return res
end ;
scaled_by(
scale : ET
) : SAME is
-- This rutne is a synonym for times above.
return times(scale)
end ;
inplace_scaled_by(
scale : ET
)
pre ~void(self) is
-- This routine sets the elements of self to be the original value
-- scaled by scale.
loop
index : CARD := asize.times! ;
[index] := [index] * scale
end
end ;
str : STR is
-- Return a string representing the vector
-- Eg. |0,1|
res ::= #FSTR+"|";
loop res := res + aelt!(0,dim-1).str + ","; end;
res := res + [dim-1].str + "|";
return(res.str);
end;
elt! : ET is
loop
yield(aelt!);
end;
end;
end ; -- VEC{ET}
partial class VEC_LENGTH_MIXIN{ET < $REAL{ET},VT < $VEC{ET, VEC}}
partial class VEC_LENGTH_MIXIN{ET < $REAL{ET},VT < $VEC{ET, VEC}} is
-- This partial class provides the definitions which are common
-- to vectors of the given element and vector types.
--
-- NOTE Most of the these definitions are NOT good for complex numbers.
--
-- Version 1.1 Sep 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 13 Jul 96 mbk Original for Sather 1.1 Dist
-- 4 Sep 97 kh Modified for CARD/portability.
include VEC{ET} ;
length_zero : ET is
-- This routine returns the length zero value of the vector.
return ET::zero
end ;
length_one : ET is
-- This routine returns the length one value of the vector.
return ET::one
end ;
inplace_normalized is
-- This routine normalises the vector self to have unity as its maximum
-- element.
inplace_scaled_by(length_one/length)
end ;
dot(
other : SAME
) : ET
pre same_size(other) is
-- This orutine returns the dot product of self and other.
res : ET := element_zero ;
loop
-- index : CARD := asize.times! ;
-- res := res + [index] * val[index]
res := res + elt! * other.elt! ;
end ;
return res
end ;
length_squared : ET is
-- This routine returns the square of the length of self -- which is, of
-- course, the dot product of self and self!
return dot(self)
end ;
length : ET is
-- This orutine returns the length of self.
return length_squared.sqrt
end ;
distance_to_squared(
other : SAME
) : ET
pre same_size(other) is
-- This routine returns the square of the distance between the vectors
-- self and other.
res : ET := length_zero ;
loop
index : CARD := asize.times! ;
temp : ET := [index] - other[index] ;
res := res + temp * temp
end ;
return res
end ;
distance_to(
other : SAME
) : ET is
-- This routine returns the distance between self and other.
return distance_to_squared(other).sqrt
end ;
bounded_distance_to_squared(
other : SAME,
limit : ET
) : ET
pre same_size(other) is
-- This routine returns either the squared distance between self and
-- other or, if the given bound is exceeded, void.
res : ET := length_zero ;
loop
index : CARD := asize.times! ;
temp : ET := [index] - other[index] ;
res := res + temp * temp ;
if res > limit then
return void
end
end ;
return res
end ;
cosine_angle_with(
other : SAME
) : ET
pre same_size(other) is
-- This routine returns the cosine of the angle between the two vectors
-- self and other, calculated from the suj of the parts divided by a
-- normalising figure derived from the length.
return dot(other) / (length * other.length)
end ;
end ; -- VEC_LENGTH_MIXIN
class VEC < $VEC{FLT,VEC,FLT}
class VEC < $VEC{FLT,VEC,FLT} is
-- This class provides a concrete instantiation of a standard vector.
-- Version 1.1 Sep 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 13 Jul 96 mbk Original for Sather 1.1 Dist
-- 4 Sep 97 kh Modified for CARD/portability.
include VEC_LENGTH_MIXIN{FLT,SAME} ;
const element_zero : FLT := 0.0 ;
const element_one : FLT := 1.0 ;
const length_zero : FLT := 0.0 ;
const length_one : FLT := 1.0 ;
angle_with(
other : SAME
) : ANGLE is
-- This routine returns the angle between self and other.
return ANGLE::acos(cosine_angle_with(other))
end ;
max_value : FLT is
-- This routine returns the value of the maximum element of self.
max : FLT := FLT::minval ;
loop
index : CARD := asize.times! ;
if [index] > max then
max := [index]
end
end ;
return max
end ;
end ; -- VEC