MtxCplx.Mod 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708
  1. (* CAPO - Computational Analysis Platform for Oberon - by Alan Freed and Felix Friedrich. *)
  2. (* Version 1, Update 2 *)
  3. MODULE MtxCplx; (** AUTHOR "fof"; PURPOSE "Matrix objects of type Real."; *)
  4. (** caution:
  5. since common indexing order in linear algebra
  6. is row then column, the x coordinate corresponds to row
  7. and y coordinate corresponds to column in this module.
  8. Do not assume x to be horizontal and y to be vertical for
  9. matrices when you use it for linear algebraic computation.
  10. *)
  11. IMPORT SYSTEM, NbrInt, ArrayXdBytes, ArrayXd := ArrayXdCplx, Array1d:= Array1dCplx, NbrCplx, DataErrors, Vec := VecCplx, NbrRat, NbrRe, MtxInt, MtxRat,
  12. MtxRe, DataIO;
  13. CONST
  14. (** The version number used when reading/writing a matrix to file. *)
  15. VERSION* = 1;
  16. TYPE
  17. Value* = ArrayXd.Value; Index* = LONGINT; IntValue = ArrayXd.IntValue; RatValue = NbrRat.Rational;
  18. ReValue = NbrRe.Real; Array* = ArrayXd.Array2; Map* = ArrayXd.Map;
  19. (** Class Matrix has been DataIO registered. *)
  20. Matrix* = OBJECT (ArrayXd.Array)
  21. VAR lenx-, leny-: LONGINT;
  22. rows-, cols-: LONGINT; (* lenx = nr.Rows, leny = nr.Columns *)
  23. VAR ox-, oy-: LONGINT;
  24. Get-: PROCEDURE {DELEGATE} ( x, y: Index ): Value;
  25. (* override *)
  26. PROCEDURE AlikeX*( ): ArrayXdBytes.Array;
  27. VAR copy: Matrix;
  28. BEGIN
  29. NEW( copy, origin[0], len[0], origin[1], len[1] ); RETURN copy;
  30. END AlikeX;
  31. PROCEDURE NewRangeX*( neworigin, newlen: ArrayXdBytes.IndexArray; copydata: BOOLEAN );
  32. BEGIN
  33. IF LEN( newlen ) # 2 THEN HALT( 1001 ) END;
  34. NewRangeX^( neworigin, newlen, copydata );
  35. END NewRangeX;
  36. PROCEDURE ValidateCache*;
  37. BEGIN
  38. ValidateCache^;
  39. IF dim # 2 THEN HALT( 100 ) END;
  40. lenx := len[0]; leny := len[1]; ox := origin[0]; oy := origin[1]; rows := lenx; cols := leny;
  41. END ValidateCache;
  42. PROCEDURE SetBoundaryCondition*( c: SHORTINT ); (* called by new, load and directly *)
  43. BEGIN
  44. SetBoundaryCondition^( c );
  45. CASE c OF
  46. ArrayXd.StrictBoundaryC:
  47. Get := Get2;
  48. | ArrayXd.AbsorbingBoundaryC:
  49. Get := Get2BAbsorbing;
  50. | ArrayXd.PeriodicBoundaryC:
  51. Get := Get2BPeriodic;
  52. | ArrayXd.SymmetricOnBoundaryC:
  53. Get := Get2BSymmetricOnB
  54. | ArrayXd.SymmetricOffBoundaryC:
  55. Get := Get2BSymmetricOffB
  56. | ArrayXd.AntisymmetricOnBoundaryC:
  57. Get := Get2BAntisymmetricOnB
  58. | ArrayXd.AntisymmetricOffBoundaryC:
  59. Get := Get2BAntisymmetricOffB
  60. END;
  61. END SetBoundaryCondition;
  62. (** new*)
  63. PROCEDURE & New*( ox, rowsORw, oy, colsORh: LONGINT );
  64. BEGIN
  65. NewXdB( ArrayXdBytes.Array2( ox, oy ), ArrayXdBytes.Array2( rowsORw, colsORh ) );
  66. END New;
  67. PROCEDURE Alike*( ): Matrix;
  68. VAR copy: ArrayXdBytes.Array;
  69. BEGIN
  70. copy := AlikeX(); RETURN copy( Matrix );
  71. END Alike;
  72. PROCEDURE NewRange*( ox, rowsORw, oy, colsORh: LONGINT; copydata: BOOLEAN );
  73. BEGIN
  74. IF (rowsORw # len[0]) OR (colsORh # len[1]) OR (ox # origin[0]) OR (oy # origin[1]) THEN
  75. NewRangeX^( ArrayXdBytes.Array2( ox, oy ), ArrayXdBytes.Array2( rowsORw, colsORh ), copydata )
  76. END;
  77. END NewRange;
  78. PROCEDURE Copy*( ): Matrix;
  79. VAR res: ArrayXdBytes.Array;
  80. BEGIN
  81. res := CopyX(); RETURN res( Matrix );
  82. END Copy;
  83. PROCEDURE Set*( rowORx (**= row or x coordinate*) , colORy (**= column or y coordinate *) : Index; v: Value );
  84. BEGIN
  85. ArrayXdBytes.Set2( SELF, rowORx, colORy, v );
  86. END Set;
  87. (** Exchanges values held by mtx[row1, k] and mtx[row2, k], 0 # k < cols. *)
  88. PROCEDURE SwapRows*( row1, row2: Index );
  89. BEGIN
  90. ToggleElements( 0, row1, row2 )
  91. END SwapRows;
  92. (** Exchanges values held by mtx[k, col1] and mtx[k, col2], 0 # k < rows. *)
  93. PROCEDURE SwapColumns*( col1, col2: Index );
  94. BEGIN
  95. ToggleElements( 1, col1, col2 )
  96. END SwapColumns;
  97. PROCEDURE Transpose*;
  98. BEGIN
  99. PermuteDimensions( ArrayXdBytes.Array2( 1, 0 ), TRUE );
  100. END Transpose;
  101. (** Stores mtx := mtx * x which requires x to be square and to have dimension cols X cols *)
  102. PROCEDURE Dot*( x: Matrix );
  103. VAR res: Matrix;
  104. BEGIN
  105. IF x # NIL THEN
  106. IF x.len[0] = x.len[1] THEN
  107. IF len[0] # len[1] THEN
  108. IF len[0] = x.len[0] THEN
  109. res := SELF * x; ArrayXdBytes.CopyArrayPartToArrayPart( res, SELF, res.origin, res.len, origin, len );
  110. ELSE DataErrors.Error( "The two matrices were not compatible" )
  111. END;
  112. ELSE DataErrors.Error( "This matrix in not square." )
  113. END
  114. ELSE DataErrors.Error( "The supplied matrix was not square." )
  115. END
  116. ELSE DataErrors.Error( "The supplied matrix to be doted was NIL." )
  117. END
  118. END Dot;
  119. (** Stores mtx := mtxT * x which requires both matrices to be square and have equal dimensions *)
  120. PROCEDURE LeftDot*( x: Matrix );
  121. BEGIN
  122. Transpose; Dot( x );
  123. END LeftDot;
  124. (** Stores mtx := mtx * xT which requires both matrices to be square and have equal dimensions *)
  125. PROCEDURE RightDot*( x: Matrix );
  126. BEGIN
  127. x.Transpose; Dot( x ); x.Transpose;
  128. END RightDot;
  129. PROCEDURE Row*( row: Index ): Vec.Vector;
  130. VAR v: Vec.Vector;
  131. BEGIN
  132. NEW( v, 0, len[1] ); ArrayXd.CopyMtxToVec( SELF, v, 1, row, 0, 0, len[1] ); RETURN v;
  133. END Row;
  134. PROCEDURE InsertRow*( at: Index );
  135. BEGIN
  136. InsertElements( 0, at, 1 ) (* insert elements in each col *)
  137. END InsertRow;
  138. PROCEDURE DeleteRow*( x: Index );
  139. BEGIN
  140. DeleteElements( 0, x, 1 ); (* delete elements from each col *)
  141. END DeleteRow;
  142. PROCEDURE Col*( col: Index ): Vec.Vector;
  143. VAR v: Vec.Vector;
  144. BEGIN
  145. NEW( v, 0, len[0] ); ArrayXd.CopyMtxToVec( SELF, v, 0, 0, col, 0, len[0] ); RETURN v;
  146. END Col;
  147. PROCEDURE InsertCol*( at: Index );
  148. BEGIN
  149. InsertElements( 1, at, 1 )
  150. END InsertCol;
  151. PROCEDURE DeleteCol*( x: Index );
  152. BEGIN
  153. DeleteElements( 1, x, 1 );
  154. END DeleteCol;
  155. (** copy methods using the current boundary condition SELF.bc*)
  156. PROCEDURE CopyToVec*( dest: ArrayXd.Array; dim: Index; srcx, srcy, destx, len: Index );
  157. VAR slen: ArrayXdBytes.IndexArray;
  158. BEGIN
  159. IF (dest.dim # 1) THEN HALT( 1002 ) END;
  160. slen := ArrayXdBytes.Index2( 1, 1 ); slen[dim] := len;
  161. CopyToArray( dest, ArrayXdBytes.Index2( srcx, srcy ), slen, ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
  162. END CopyToVec;
  163. PROCEDURE CopyToMtx*( dest: ArrayXd.Array; srcx, srcy, destx, desty, lenx, leny: Index );
  164. VAR slen: ArrayXdBytes.IndexArray;
  165. BEGIN
  166. IF (dest.dim # 2) THEN HALT( 1005 ) END;
  167. slen := ArrayXdBytes.Index2( lenx, leny );
  168. CopyToArray( dest, ArrayXdBytes.Index2( srcx, srcy ), slen, ArrayXdBytes.Index2( destx, desty ), slen );
  169. END CopyToMtx;
  170. PROCEDURE CopyToCube*( dest: ArrayXd.Array; dimx, dimy: Index; srcx, srcy, destx, desty, destz, lenx, leny: Index );
  171. VAR slen: ArrayXdBytes.IndexArray;
  172. BEGIN
  173. IF (dest.dim # 3) OR (dimx >= dimy) THEN HALT( 1005 ) END;
  174. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  175. CopyToArray( dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
  176. ArrayXdBytes.Index3( destx, desty, destz ), slen );
  177. END CopyToCube;
  178. PROCEDURE CopyToHCube*( dest: ArrayXd.Array; dimx, dimy: Index;
  179. srcx, srcy, destx, desty, destz, destt, lenx, leny: Index );
  180. VAR slen: ArrayXdBytes.IndexArray;
  181. BEGIN
  182. IF (dest.dim # 4) OR (dimx >= dimy) THEN HALT( 1005 ) END;
  183. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  184. CopyToArray( dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
  185. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  186. END CopyToHCube;
  187. PROCEDURE CopyTo1dArray*( VAR dest: ARRAY OF Value; sx, sy, slenx, sleny: Index; dpos, dlen: LONGINT );
  188. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  189. BEGIN
  190. destm :=
  191. ArrayXdBytes.MakeMemoryStructure( 1, ArrayXdBytes.Index1( 0 ), ArrayXdBytes.Index1( LEN( dest ) ), SIZEOF( Value ),
  192. ADDRESSOF( dest[0] ) );
  193. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index2( sx, sy ), ArrayXdBytes.Index2( slenx, sleny ),
  194. ArrayXdBytes.Index1( dpos ), ArrayXdBytes.Index1( dlen ) );
  195. END CopyTo1dArray;
  196. PROCEDURE CopyTo2dArray*( VAR dest: ARRAY OF ARRAY OF Value; sx, sy, slenx, sleny: Index; dposx, dposy, dlenx, dleny: LONGINT );
  197. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  198. BEGIN
  199. destm :=
  200. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( dest, 1 ), LEN( dest, 0 ) ),
  201. SIZEOF( Value ), ADDRESSOF( dest[0, 0] ) );
  202. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index2( sx, sy ), ArrayXdBytes.Index2( slenx, sleny ),
  203. ArrayXdBytes.Index2( dposx, dposy ), ArrayXdBytes.Index2( dlenx, dleny ) );
  204. END CopyTo2dArray;
  205. PROCEDURE CopyTo3dArray*( VAR dest: ARRAY OF ARRAY OF ARRAY OF Value; sx, sy, slenx, sleny: Index;
  206. dposx, dposy, dposz, dlenx, dleny, dlenz: LONGINT );
  207. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  208. BEGIN
  209. destm :=
  210. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  211. ArrayXdBytes.Index3( LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  212. ADDRESSOF( dest[0, 0, 0] ) );
  213. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index2( sx, sy ), ArrayXdBytes.Index2( slenx, sleny ),
  214. ArrayXdBytes.Index3( dposx, dposy, dposz ),
  215. ArrayXdBytes.Index3( dlenx, dleny, dlenz ) );
  216. END CopyTo3dArray;
  217. PROCEDURE CopyTo4dArray*( VAR dest: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value; sx, sy, slenx, sleny: Index;
  218. dposx, dposy, dposz, dpost, dlenx, dleny, dlenz, dlent: LONGINT );
  219. VAR destm: ArrayXdBytes.ArrayMemoryStructure;
  220. BEGIN
  221. destm :=
  222. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  223. ArrayXdBytes.Index4( LEN( dest, 3 ), LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  224. ADDRESSOF( dest[0, 0, 0, 0] ) );
  225. ArrayXd.CopyArrayToArrayPartB( SELF, destm, bc, ArrayXdBytes.Index2( sx, sy ), ArrayXdBytes.Index2( slenx, sleny ),
  226. ArrayXdBytes.Index4( dposx, dposy, dposz, dpost ),
  227. ArrayXdBytes.Index4( dlenx, dleny, dlenz, dlent ) );
  228. END CopyTo4dArray;
  229. (** copy from without boundary conditions *)
  230. PROCEDURE CopyFrom1dArray*( VAR src: ARRAY OF Value; spos, slen: Index; dx, dy, dlenx, dleny: Index );
  231. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  232. BEGIN
  233. srcm :=
  234. ArrayXdBytes.MakeMemoryStructure( 1, ArrayXdBytes.Index1( 0 ), ArrayXdBytes.Index1( LEN( src ) ), SIZEOF( Value ),
  235. ADDRESSOF( src[0] ) );
  236. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index1( spos ), ArrayXdBytes.Index1( slen ),
  237. ArrayXdBytes.Index2( dx, dy ), ArrayXdBytes.Index2( dlenx, dleny ) );
  238. END CopyFrom1dArray;
  239. PROCEDURE CopyFrom2dArray*( VAR src: ARRAY OF ARRAY OF Value; sposx, spoxy, slenx, sleny: Index;
  240. dx, dy, dlenx, dleny: Index );
  241. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  242. BEGIN
  243. srcm :=
  244. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( src, 1 ), LEN( src, 0 ) ),
  245. SIZEOF( Value ), ADDRESSOF( src[0, 0] ) );
  246. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index2( sposx, spoxy ),
  247. ArrayXdBytes.Index2( slenx, sleny ), ArrayXdBytes.Index2( dx, dy ),
  248. ArrayXdBytes.Index2( dlenx, dleny ) );
  249. END CopyFrom2dArray;
  250. PROCEDURE CopyFrom3dArray*( VAR src: ARRAY OF ARRAY OF ARRAY OF Value; sposx, spoxy, sposz, slenx, sleny, slenz: Index;
  251. dx, dy, dlenx, dleny: Index );
  252. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  253. BEGIN
  254. srcm :=
  255. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  256. ArrayXdBytes.Index3( LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  257. ADDRESSOF( src[0, 0, 0] ) );
  258. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index3( sposx, spoxy, sposz ),
  259. ArrayXdBytes.Index3( slenx, sleny, slenz ), ArrayXdBytes.Index2( dx, dy ),
  260. ArrayXdBytes.Index2( dlenx, dleny ) );
  261. END CopyFrom3dArray;
  262. PROCEDURE CopyFrom4dArray*( VAR src: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
  263. sposx, spoxy, sposz, spost, slenx, sleny, slenz, slent: Index; dx, dy, dlenx, dleny: Index );
  264. VAR srcm: ArrayXdBytes.ArrayMemoryStructure;
  265. BEGIN
  266. srcm :=
  267. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  268. ArrayXdBytes.Index4( LEN( src, 3 ), LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  269. ADDRESSOF( src[0, 0, 0, 0] ) );
  270. ArrayXdBytes.CopyArrayPartToArrayPart( srcm, SELF, ArrayXdBytes.Index4( sposx, spoxy, sposz, spost ),
  271. ArrayXdBytes.Index4( slenx, sleny, slenz, slent ),
  272. ArrayXdBytes.Index2( dx, dy ), ArrayXdBytes.Index2( dlenx, dleny ) );
  273. END CopyFrom4dArray;
  274. END Matrix;
  275. PROCEDURE FrobeniusNorm*( m: Matrix ): NbrRe.Real;
  276. BEGIN
  277. RETURN Array1d.L2Norm( m.data^, 0, LEN( m.data ) );
  278. END FrobeniusNorm;
  279. PROCEDURE Transpose*( u: Matrix ): Matrix;
  280. VAR res: Matrix;
  281. BEGIN
  282. res := u.Copy(); res.Transpose; RETURN res;
  283. END Transpose;
  284. OPERATOR ":="*( VAR l: Matrix; VAR r: ARRAY OF ARRAY OF Value );
  285. BEGIN
  286. (* IF r = NIL THEN l := NIL; RETURN END; *)
  287. IF l = NIL THEN NEW( l, 0, LEN( r, 1 ), 0, LEN( r, 0 ) ) ELSE l.NewRange( 0, LEN( r, 1 ), 0, LEN( r, 0 ), FALSE ); END;
  288. ArrayXdBytes.CopyMemoryToArrayPart( ADDRESSOF( r[0, 0] ), l, LEN( r, 1 ) * LEN( r, 0 ), NIL , NIL );
  289. END ":=";
  290. OPERATOR ":="*( VAR l: Matrix; r: Vec.Vector );
  291. BEGIN
  292. (* IF r = NIL THEN l := NIL; RETURN END; *)
  293. IF l = NIL THEN NEW( l, 0, 1, 0, r.len[0] ) ELSE l.NewRange( 0, 1, 0, r.len[0], FALSE ); END;
  294. ArrayXdBytes.CopyDataRaw( r, l );
  295. END ":=";
  296. OPERATOR ":="*( VAR l: Matrix; r: MtxInt.Matrix );
  297. VAR i, last: LONGINT;
  298. BEGIN
  299. IF r = NIL THEN l := NIL ELSE
  300. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1] ); END;
  301. last := LEN( r.data ) - 1;
  302. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  303. END;
  304. END ":=";
  305. OPERATOR ":="*( VAR l: Matrix; r: MtxRat.Matrix );
  306. VAR i, last: LONGINT;
  307. BEGIN
  308. IF r = NIL THEN l := NIL ELSE
  309. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1] ); END;
  310. last := LEN( r.data ) - 1;
  311. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  312. END;
  313. END ":=";
  314. OPERATOR ":="*( VAR l: Matrix; r: MtxRe.Matrix );
  315. VAR i, last: LONGINT;
  316. BEGIN
  317. IF r = NIL THEN l := NIL ELSE
  318. IF l = NIL THEN NEW( l, r.origin[0], r.len[0], r.origin[1], r.len[1] ); END;
  319. last := LEN( r.data ) - 1;
  320. FOR i := 0 TO last DO l.data[i] := r.data[i]; END;
  321. END;
  322. END ":=";
  323. OPERATOR ":="*( VAR l: Matrix; r: Value );
  324. BEGIN
  325. IF l # NIL THEN ArrayXd.Fill( l, r ); END;
  326. END ":=";
  327. OPERATOR ":="*( VAR l: Matrix; r: ReValue );
  328. VAR r1: Value;
  329. BEGIN
  330. r1 := r; l := r1;
  331. END ":=";
  332. OPERATOR ":="*( VAR l: Matrix; r: RatValue );
  333. VAR r1: Value;
  334. BEGIN
  335. r1 := r; l := r1;
  336. END ":=";
  337. OPERATOR ":="*( VAR l: Matrix; r: IntValue );
  338. VAR r1: Value;
  339. BEGIN
  340. r1 := r; l := r1;
  341. END ":=";
  342. OPERATOR "+"*( l, r: Matrix ): Matrix;
  343. VAR res: Matrix;
  344. BEGIN
  345. res := l.Alike(); ArrayXd.Add( l, r, res ); RETURN res;
  346. END "+";
  347. OPERATOR "-"*( l, r: Matrix ): Matrix;
  348. VAR res: Matrix;
  349. BEGIN
  350. res := l.Alike(); ArrayXd.Sub( l, r, res ); RETURN res;
  351. END "-";
  352. OPERATOR "+"*( l: Matrix; r: Value ): Matrix;
  353. VAR res: Matrix;
  354. BEGIN
  355. res := l.Alike(); ArrayXd.AddAV( l, r, res ); RETURN res;
  356. END "+";
  357. OPERATOR "+"*( l: Matrix; r: ReValue ): Matrix;
  358. VAR res: Matrix; r1: Value;
  359. BEGIN
  360. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  361. END "+";
  362. OPERATOR "+"*( l: Matrix; r: RatValue ): Matrix;
  363. VAR res: Matrix; r1: Value;
  364. BEGIN
  365. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  366. END "+";
  367. OPERATOR "+"*( l: Matrix; r: IntValue ): Matrix;
  368. VAR res: Matrix; r1: Value;
  369. BEGIN
  370. res := l.Alike(); r1 := r; ArrayXd.AddAV( l, r1, res ); RETURN res;
  371. END "+";
  372. OPERATOR "+"*( l: Value; r: Matrix ): Matrix;
  373. BEGIN
  374. RETURN r + l
  375. END "+";
  376. OPERATOR "+"*( l: ReValue; r: Matrix ): Matrix;
  377. BEGIN
  378. RETURN r + l
  379. END "+";
  380. OPERATOR "+"*( l: RatValue; r: Matrix ): Matrix;
  381. BEGIN
  382. RETURN r + l
  383. END "+";
  384. OPERATOR "+"*( l: IntValue; r: Matrix ): Matrix;
  385. BEGIN
  386. RETURN r + l
  387. END "+";
  388. OPERATOR "-"*( l: Matrix; r: Value ): Matrix;
  389. VAR res: Matrix;
  390. BEGIN
  391. res := l.Alike(); ArrayXd.SubAV( l, r, res ); RETURN res;
  392. END "-";
  393. OPERATOR "-"*( l: Matrix; r: ReValue ): Matrix;
  394. VAR res: Matrix; r1: Value;
  395. BEGIN
  396. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  397. END "-";
  398. OPERATOR "-"*( l: Matrix; r: RatValue ): Matrix;
  399. VAR res: Matrix; r1: Value;
  400. BEGIN
  401. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  402. END "-";
  403. OPERATOR "-"*( l: Matrix; r: IntValue ): Matrix;
  404. VAR res: Matrix; r1: Value;
  405. BEGIN
  406. res := l.Alike(); r1 := r; ArrayXd.SubAV( l, r1, res ); RETURN res;
  407. END "-";
  408. OPERATOR "-"*( l: Value; r: Matrix ): Matrix;
  409. VAR res: Matrix;
  410. BEGIN
  411. res := r.Alike(); ArrayXd.SubVA( l, r, res ); RETURN res;
  412. END "-";
  413. OPERATOR "-"*( l: ReValue; r: Matrix ): Matrix;
  414. VAR res: Matrix; l1: Value;
  415. BEGIN
  416. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  417. END "-";
  418. OPERATOR "-"*( l: RatValue; r: Matrix ): Matrix;
  419. VAR res: Matrix; l1: Value;
  420. BEGIN
  421. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  422. END "-";
  423. OPERATOR "-"*( l: IntValue; r: Matrix ): Matrix;
  424. VAR res: Matrix; l1: Value;
  425. BEGIN
  426. res := r.Alike(); l1 := l; ArrayXd.SubVA( l1, r, res ); RETURN res;
  427. END "-";
  428. OPERATOR "-"*( l: Matrix ): Matrix;
  429. BEGIN
  430. RETURN 0 - l;
  431. END "-";
  432. OPERATOR "*"*( l: Matrix; r: Value ): Matrix;
  433. VAR res: Matrix;
  434. BEGIN
  435. res := l.Alike(); ArrayXd.MulAV( l, r, res ); RETURN res;
  436. END "*";
  437. OPERATOR "*"*( l: Matrix; r: ReValue ): Matrix;
  438. VAR res: Matrix; r1: Value;
  439. BEGIN
  440. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  441. END "*";
  442. OPERATOR "*"*( l: Matrix; r: RatValue ): Matrix;
  443. VAR res: Matrix; r1: Value;
  444. BEGIN
  445. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  446. END "*";
  447. OPERATOR "*"*( l: Matrix; r: IntValue ): Matrix;
  448. VAR res: Matrix; r1: Value;
  449. BEGIN
  450. res := l.Alike(); r1 := r; ArrayXd.MulAV( l, r1, res ); RETURN res;
  451. END "*";
  452. OPERATOR "*"*( l: Value; r: Matrix ): Matrix;
  453. BEGIN
  454. RETURN r * l;
  455. END "*";
  456. OPERATOR "*"*( l: ReValue; r: Matrix ): Matrix;
  457. BEGIN
  458. RETURN r * l;
  459. END "*";
  460. OPERATOR "*"*( l: RatValue; r: Matrix ): Matrix;
  461. BEGIN
  462. RETURN r * l;
  463. END "*";
  464. OPERATOR "*"*( l: IntValue; r: Matrix ): Matrix;
  465. BEGIN
  466. RETURN r * l;
  467. END "*";
  468. OPERATOR "/"*( l: Matrix; r: Value ): Matrix;
  469. VAR res: Matrix;
  470. BEGIN
  471. res := l.Alike(); ArrayXd.DivAV( l, r, res ); RETURN res;
  472. END "/";
  473. OPERATOR "/"*( l: Matrix; r: ReValue ): Matrix;
  474. VAR res: Matrix; r1: Value;
  475. BEGIN
  476. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  477. END "/";
  478. OPERATOR "/"*( l: Matrix; r: RatValue ): Matrix;
  479. VAR res: Matrix; r1: Value;
  480. BEGIN
  481. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  482. END "/";
  483. OPERATOR "/"*( l: Matrix; r: IntValue ): Matrix;
  484. VAR res: Matrix; r1: Value;
  485. BEGIN
  486. res := l.Alike(); r1 := r; ArrayXd.DivAV( l, r1, res ); RETURN res;
  487. END "/";
  488. OPERATOR "/"*( l: Value; r: Matrix ): Matrix;
  489. VAR res: Matrix;
  490. BEGIN
  491. res := r.Alike(); ArrayXd.DivVA( l, r, res ); RETURN res;
  492. END "/";
  493. OPERATOR "/"*( l: ReValue; r: Matrix ): Matrix;
  494. VAR res: Matrix; l1: Value;
  495. BEGIN
  496. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  497. END "/";
  498. OPERATOR "/"*( l: RatValue; r: Matrix ): Matrix;
  499. VAR res: Matrix; l1: Value;
  500. BEGIN
  501. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  502. END "/";
  503. OPERATOR "/"*( l: IntValue; r: Matrix ): Matrix;
  504. VAR res: Matrix; l1: Value;
  505. BEGIN
  506. res := r.Alike(); l1 := l; ArrayXd.DivVA( l1, r, res ); RETURN res;
  507. END "/";
  508. (*
  509. OPERATOR "MOD"*( l: Matrix; r: Value ): Matrix;
  510. VAR res: Matrix;
  511. BEGIN
  512. res := l.Alike(); ArrayXd.ModAV( l, r, res ); RETURN res;
  513. END "MOD";
  514. OPERATOR "MOD"*( l: Value; r: Matrix ): Matrix;
  515. VAR res: Matrix;
  516. BEGIN
  517. res := r.Alike(); ArrayXd.ModVA( l, r, res ); RETURN res;
  518. END "MOD";
  519. *)
  520. OPERATOR "*"*( l: Vec.Vector; r: Matrix ): Vec.Vector;
  521. VAR res: Vec.Vector; rc, rr, lc, i, j: LONGINT; sum: Value;
  522. BEGIN
  523. rc := r.cols; rr := r.rows; lc := l.lenx;
  524. IF lc # rr THEN DataErrors.Error( "The supplied matrix / vector were incompatible." ); HALT( 100 );
  525. ELSE
  526. NEW( res, 0, rc );
  527. FOR i := 0 TO rc - 1 DO (* right columns *)
  528. sum := 0;
  529. FOR j := 0 TO lc - 1 DO sum := sum + l.Get( j ) * r.Get( j, i ); END;
  530. res.Set( i, sum );
  531. END;
  532. END;
  533. RETURN res;
  534. END "*";
  535. OPERATOR "*"*( l: Matrix; r: Vec.Vector ): Vec.Vector;
  536. VAR res: Vec.Vector; lr, lc, rr, i, j: LONGINT; sum: Value;
  537. BEGIN
  538. lr := l.rows; lc := l.cols; rr := r.lenx;
  539. IF lc # rr THEN DataErrors.Error( "The supplied matrix / vector were incompatible." ); HALT( 100 );
  540. ELSE
  541. NEW( res, 0, lr );
  542. FOR i := 0 TO lr - 1 DO
  543. sum := 0;
  544. FOR j := 0 TO lc - 1 DO sum := sum + l.Get( i, j ) * r.Get( j ); END;
  545. res.Set( i, sum );
  546. END;
  547. END;
  548. RETURN res;
  549. END "*";
  550. OPERATOR "*"*( l, r: Matrix ): Matrix;
  551. VAR res: Matrix; rr, rc, lr, lc, i, j, k: LONGINT; sum: Value;
  552. (**! far from opimal: use internal routines of ArrayXdBytes *)
  553. BEGIN
  554. rc := r.cols; (* columns of right matrix *)
  555. rr := r.rows; (* rows of right matrix *)
  556. lr := l.rows; lc := l.cols;
  557. IF lc # rr THEN DataErrors.Error( "The supplied matrices were incompatible." ); HALT( 100 )
  558. ELSE
  559. NEW( res, 0, lr, 0, rc );
  560. FOR i := 0 TO lr - 1 DO (* left rows*)
  561. FOR j := 0 TO rc - 1 DO (* right columns *)
  562. sum := 0;
  563. FOR k := 0 TO lc - 1 (* = rr -1 *) DO sum := sum + l.Get( i, k ) * r.Get( k, j ); END;
  564. res.Set( i, j, sum );
  565. END;
  566. END;
  567. END;
  568. RETURN res;
  569. END "*";
  570. (* The procedures needed to register type Matrix so that its instances can be made persistent. *)
  571. PROCEDURE LoadMatrix( R: DataIO.Reader; VAR obj: OBJECT );
  572. VAR a: Matrix; version: SHORTINT; ver: NbrInt.Integer;
  573. BEGIN
  574. R.RawSInt( version );
  575. IF version = -1 THEN
  576. obj := NIL (* Version tag is -1 for NIL. *)
  577. ELSIF version = VERSION THEN NEW( a, 0, 0, 0, 0 ); a.Read( R ); obj := a
  578. ELSE (* Encountered an unknown version number. *)
  579. ver := version; DataErrors.IntError( ver, "Alien version number encountered." ); HALT( 1000 )
  580. END
  581. END LoadMatrix;
  582. PROCEDURE StoreMatrix( W: DataIO.Writer; obj: OBJECT );
  583. VAR a: Matrix;
  584. BEGIN
  585. IF obj = NIL THEN W.RawSInt( -1 ) ELSE W.RawSInt( VERSION ); a := obj( Matrix ); a.Write( W ) END
  586. END StoreMatrix;
  587. PROCEDURE Register;
  588. VAR a: Matrix;
  589. BEGIN
  590. NEW( a, 0, 0, 0, 0 ); DataIO.PlugIn( a, LoadMatrix, StoreMatrix )
  591. END Register;
  592. (** Load and Store are procedures for external use that read/write an instance of Matrix from/to a file. *)
  593. PROCEDURE Load*( R: DataIO.Reader; VAR obj: Matrix );
  594. VAR ptr: OBJECT;
  595. BEGIN
  596. R.Object( ptr ); obj := ptr( Matrix )
  597. END Load;
  598. PROCEDURE Store*( W: DataIO.Writer; obj: Matrix );
  599. BEGIN
  600. W.Object( obj )
  601. END Store;
  602. BEGIN
  603. Register
  604. END MtxCplx.