1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
{
This file is part of the Numlib package.
Copyright (c) 1986-2000 by
Kees van Ginneken, Wil Kortsmit and Loek van Reij of the
Computational centre of the Eindhoven University of Technology
FPC port Code by Marco van de Voort (marco@freepascal.org)
documentation by Michael van Canneyt (Michael@freepascal.org)
Basic In and output of matrix and vector types. Maybe too simple for
your application, but still handy for logging and debugging.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program 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.
**********************************************************************}
unit iom;
interface
{$I direct.inc}
uses typ;
const
npos : ArbInt = 78;
{Read a n-dimensional vector v from textfile}
procedure iomrev(var inp: text; var v: ArbFloat; n: ArbInt);
{Read a m x n-dimensional matrix a from textfile}
procedure iomrem(var inp: text; var a: ArbFloat; m, n, rwidth: ArbInt);
{Write a n-dimensional vectorv v to textfile}
procedure iomwrv(var out: text; var v: ArbFloat; n, form: ArbInt);
{Write a m x n-dimensional matrix a to textfile}
procedure iomwrm(var out: text; var a: ArbFloat; m, n, rwidth, form: ArbInt);
{Read a m x n-dimensional matrix a from string}
procedure iomrems(inp: ArbString; var a: ArbFloat; var m, n: ArbInt; c: ArbInt);
{Write a m x n-dimensional matrix a to string}
procedure iomwrms(var out: ArbString; var a: ArbFloat; m, n, form, c: ArbInt);
implementation
procedure iomrev(var inp: text; var v: ArbFloat; n: ArbInt);
var pv : ^arfloat1;
i : ArbInt;
BEGIN
pv:=@v; for i:=1 to n do read(inp, pv^[i])
END {iomrev};
procedure iomrem(var inp: text; var a: ArbFloat; m, n, rwidth: ArbInt);
var pa : ^arfloat1;
i, k : ArbInt;
BEGIN
pa:=@a; k:=1;
for i:=1 to m do
BEGIN
iomrev(inp, pa^[k], n); Inc(k, rwidth)
END
END {iomrem};
procedure iomwrv(var out: text; var v: ArbFloat; n, form: ArbInt);
var pv : arfloat1 absolute v;
i, i1 : ArbInt;
BEGIN
if form>maxform then form:=maxform else
if form<minform then form:=minform;
i1:=npos div (form+2);
for i:=1 to n do
if ((i mod i1)=0) or (i=n) then writeln(out, pv[i]:form)
else write(out, pv[i]:form, '':2)
END {iomwrv};
procedure iomwrm(var out: text; var a: ArbFloat; m, n, rwidth, form: ArbInt);
var pa : ^arfloat1;
i, k, nb, i1, l, j, r, l1, kk : ArbInt;
BEGIN
if (n<1) or (m<1) then exit;
pa:=@a;
if form>maxform then form:=maxform else
if form<minform then form:=minform;
i1:=npos div (form+2); l1:=0;
nb:=n div i1; r:=n mod i1;
if r>0 then Inc(nb);
for l:=1 to nb do
BEGIN
k:=l1+1; if (r>0) and (l=nb) then i1:=r;
for i:=1 to m do
BEGIN
kk:=k;
for j:=1 to i1-1 do
BEGIN
write(out, pa^[kk]:form, '':2); Inc(kk)
END;
writeln(out, pa^[kk]:form); Inc(k, rwidth)
END;
Inc(l1, i1); if l<nb then writeln(out)
END;
END {iomwrm};
procedure iomrems(inp: ArbString; var a: ArbFloat; var m, n: ArbInt; c: ArbInt);
var
pa: ^arfloat1;
i, k: ArbInt;
err: ArbInt;
s: ArbString;
ni: ArbInt;
ci: ArbInt;
begin
pa:=@a;
k:=1;
m:=0;
n:=0;
//parse the text
i:= 1;
while i < Length(inp) do
begin
ni := 1;
ci := 1;
//parse row
while not (inp[i] in ['}']) do
begin
//go to beginning of row values
while inp[i] in ['{',' '] do
begin
//increase row counter
if inp[i] = '{' then
Inc(m);
Inc(i);
end;
//get value from string
s := '';
while inp[i] in ['0'..'9','E','e','+','-'] do
begin
s := s + inp[i];
Inc(i);
end;
//assign value to element
val(s, pa^[k], err);
Inc(k);
if err <> 0 then
writeln('Val(',s,') failed at position ', err);
Inc(ci);
end;
k := ((k div c) + 1) * c + 1;
Inc(ni);
if ni > n then n := ni;
Inc(i);
end;
end;
procedure iomwrms(var out: ArbString; var a: ArbFloat; m, n, form, c: ArbInt);
var
pa: ^arfloat1;
i, l, kk: ArbInt;
s: string;
BEGIN
if (n<1) or (m<1) then
exit;
pa:=@a;
if form>maxform then
form:=maxform
else
if form<minform then
form:=minform;
kk := 1;
for l:=1 to m do
BEGIN
out := out + '{';
for i:=1 to n do
BEGIN
str(pa^[kk]:form, s);
Inc(kk);
if i <> n then
out := out + s + ' '
else
out := out + s;
END;
kk := ((kk div c) + 1) * c + 1;
out := out + ' }';
end;
end;
END.
|
