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