Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.86/21: Рейтинг темы: голосов - 21, средняя оценка - 4.86
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
1

Написать процедуру считывания матрицы из файла

06.06.2015, 15:33. Показов 3991. Ответов 25
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Вот написал процедуру считывания матрицы с клавиатуры

Pascal
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
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
 
Var
 
   i, j, r: Integer;
 
Begin
 
     r := WhereY;
 
     GotoXY(2, r);
 
     Write('A');
 
     For i := 1 to n do begin
 
         GotoXY(i * 6 + 2, r);
 
         Write(i);
 
         GotoXY(1, r + i + 1);
 
         Write(i:2);
 
     end;
 
     GotoXY((n + 1) * 6 + 2, r);
 
     Write('b');
 
     For i := 1 to n do begin
 
         For j := 1 to n do begin
 
             GotoXY(j * 6 + 2, r + i + 1);
 
             Read(a[i, j]);
 
         end;
 
         GotoXY((n + 1) * 6 + 2, r + i + 1);
 
         Read(b[i]);
 
     end;
 
End;
Нужно написать процедуру считывания матрицы из файла. Написал так

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Procedure ReadSystem;
    var
    f:file of integer;
    a:array[0..9,0..9]of integer;
    MStr,Mcol,i,j:integer;
    Begin
    assign(f,'matrix.txt');
    reset(f);
    read(f,mstr);
    read(f,mcol);
    for i:=0 to mstr-1 do
    for j:=0 to mcol-1 do
    begin
    read(f,a[i,j])
    end;
    close(f);
    end;
Пишет что ошибка 100!
Подскажите, где ошибка ((( ?
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
06.06.2015, 15:33
Ответы с готовыми решениями:

Написать программу для считывания элементов матрицы размером М х N из файла
Помогите решить такую проблему. Задача проста но суть в том чтобы не пользоваться Fstream и...

Написать процедуру создания типизированного файла из первых строк целочисленной матрицы
Процедура создания файла типизированного из первых строк целочисленный матриц 4-го порядка,...

Визуальное программирование. Написать процедуру для ввода из файла прямоугольной символьной матрицы
Написать процедуру для ввода из файла прямоугольной символьной матрицы размерности...

Написать функцию шаблон, для считывания из файла
Написать функцию шаблон, для считывания из файла

25
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 16:14 2
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
type mtr=array[1..9,1..9]of integer;
Procedure ReadSystem(var f:text;var a:mtr;var mstr,mcol:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol);
for i:=1 to mstr do
for j:=1 to mcol do
read(f,a[i,j])
close(f);
end;
1
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 16:37  [ТС] 3
а вызвать в программе процедуру с какими параметрами??
ReadSystem(?,?,?);
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 17:08 4
Pascal
1
2
3
4
5
var f:text;
     a:mtr;
     m,n:byte;//размеры матрицы
............................
ReadSystem(f,a,m,n);
1
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 18:49  [ТС] 5
Pascal
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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
Uses CRT,DOS;
 
Const
 
     maxn = 10;
 
Type
 
    Data = Real;
 
    Matrix = Array[1..maxn, 1..maxn] of Data;
 
    Vector = Array[1..maxn] of Data;
{Schitivaem vremya}
 
function fGetTime:LongInt;
 
var hr,min,sec,sec_100:word;
 
begin
gettime(hr,min,sec,sec_100);
 
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
 
 
{PROCEDURA VVODA RASHIRENNOI MATRICI SYSTEM }
 
 
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
 
Var
 
   i, j, r: Integer;
 
Begin
 
     r := WhereY;
 
     GotoXY(2, r);
 
     Write('A');
 
     For i := 1 to n do begin
 
         GotoXY(i * 6 + 2, r);
 
         Write(i);
 
         GotoXY(1, r + i + 1);
 
         Write(i:2);
 
     end;
 
     GotoXY((n + 1) * 6 + 2, r);
 
     Write('b');
 
     For i := 1 to n do begin
 
         For j := 1 to n do begin
 
             GotoXY(j * 6 + 2, r + i + 1);
 
             Read(a[i, j]);
 
         end;
 
         GotoXY((n + 1) * 6 + 2, r + i + 1);
 
         Read(b[i]);
 
     end;
 
End;
 
{ Procedura vivoda rezultata }
 
Procedure WriteX(n :Integer; x: Vector);
 
Var
 
   i: Integer;
 
Begin
 
     For i := 1 to n do
 
         Writeln('x', i, ' = ', x[i]);
 
End;
 
{Funciya, realizuyshaya metod Zeidelya }
 
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
 
Var
 
   i, j: Integer;
 
   s1, s2, s, v, m: Data;
 
Begin
 
     {Isleduem Sxodimost}
 
     For i := 1 to n do begin
 
         s := 0;
 
         For j := 1 to n do
 
             If j <> i then
 
                s := s + Abs(a[i, j]);
 
         If s >= Abs(a[i, i]) then begin
 
            Seidel := false;
 
            Exit;
 
         end;
 
     end;
 
     Repeat
 
         m := 0;
 
         For i := 1 to n do begin
 
             { Vichislaem summi }
 
             s1 := 0;
 
             s2 := 0;
 
             For j := 1 to i - 1 do
 
                 s1 := s1 + a[i, j] * x[j];
 
             For j := i to n do
 
                 s2 := s2 + a[i, j] * x[j];
 
             { Vichislaem novoe priblizhenie i pogreshnost }
 
             v := x[i];
 
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
 
             If Abs(v - x[i]) > m then
 
                m := Abs(v - x[i]);
 
         end;
 
     Until m < e;
 
     Seidel := true;
 
End;
{ Gaus function }
 
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
 
Var
 
   i, j, k, l: Integer;
 
   q, m, t: Data;
 
Begin
 
     For k := 1 to n - 1 do begin
 
         { Ishem Stroku s max elementom d k-om stolbce}
 
         l := 0;
 
         m := 0;
 
         For i := k to n do
 
             If Abs(a[i, k]) > m then begin
 
                m := Abs(a[i, k]);
 
                l := i;
 
             end;
 
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
 
         If l = 0 then begin
 
            Gauss := false;
 
            Exit;
 
         end;
 
         { Menyaem mestom 1-y stroku s K-oi }
 
         If l <> k then begin
 
            For j := 1 to n do begin
 
                t := a[k, j];
 
                a[k, j] := a[l, j];
 
                a[l, j] := t;
 
            end;
 
            t := b[k];
 
            b[k] := b[l];
 
            b[l] := t;
 
         end;
 
         {Preobrazuem matrix}
 
         For i := k + 1 to n do begin
 
             q := a[i, k] / a[k, k];
 
             For j := 1 to n do
 
                 If j = k then
 
                    a[i, j] := 0
 
                 else
 
                      a[i, j] := a[i, j] - q * a[k, j];
 
                 b[i] := b[i] - q * b[k];
 
             end;
 
     end;
 
     { Vichislaem reshenie }
 
     x[n] := b[n] / a[n, n];
 
     For i := n - 1 downto 1 do begin
 
         t := 0;
 
         For j := 1 to n-i do
 
             t := t + a[i, i + j] * x[i + j];
 
         x[i] := (1 / a[i, i]) * (b[i] - t);
 
     end;
 
     Gauss := true;
 
End;
 
Var
 
    n, i: Integer;
 
    a: Matrix;
 
    b, x: Vector;
 
    ch:char;
 
    e: Data;
 
    before, after:longint;
 
label 1,2,3;
 
Begin
 
      ClrScr;
before:=fGettime;
 
{--------Vibor knopok-----------------}
writeln('Klavisha <TAB> - Metod Zeidel, lubaya drugaya klavisha - Metod Gausa');
ch:=readkey;
 
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Programma resheniya SLU po metodu Zeidel');
 
      Writeln;
 
      Writeln('VVedite poryadok matrix system max. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Vvedite tochnost vichislenii');
 
      Repeat
 
             Write('>');
 
             Read(e);
 
      Until (e > 0) and (e < 1);
 
      Writeln;
 
      Writeln('Vvedite rashirennuy matrix system');
 
      ReadSystem(n, a, b);
 
      Writeln;
 
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
 
      For i := 1 to n do
 
          x[i] := 0;
 
      If Seidel(n, a, b, x, e) then begin
 
         Writeln('Rezultat vichislenii po metodu Zeidelya');
 
         WriteX(n, x);
 
       readln;
       end
 
      else
 
          Writeln('Metod Zeidelya ne sxodica dlya dannoi system');
    after:=fgetTime;
writeln('Deistvie vipolnyalos: ',(after-before)/100:0:2,'sec');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
 
2:
 
 Writeln('Programma resheniya SLU po metodu Gauss');
 
      Writeln;
 
      Writeln('VVedite poryadok matrix system max. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Vvedite rashirennuy matrix system');
 
      ReadSystem(n, a, b);
 
      Writeln;
 
      If Gauss(n, a, b, x) then begin
 
         Writeln('Rezultat vichislenii po metodu Gaussa');
 
         WriteX(n, x);
      after:=fgetTime;
writeln('Deistvie vipolnyalos: ',(after-before)/100:0:2,'sec');
         readln;
      end
 
      else
 
          Writeln('Dannuy systemu nevozmozhno reshit metodom Gaussa');
      Writeln;
3:    readln;
 
End.
Добавлено через 7 минут
нужно переработать процедуру Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector); для ввода данных из файла в Файле есть 2 матрицы:
1) 1 1 1 1 1
А 1 1 1 1 В 1
1 1 1 1 1
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 18:52 6
Цитата Сообщение от Viper1980 Посмотреть сообщение
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
И где здесь чтение из файла? Я Вам написал как нужно, больше прошу не беспокоить.
0
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 18:56  [ТС] 7
одна матрица 4*4 вторая 1*4

Добавлено через 3 минуты
Pascal
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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
Uses CRT,DOS;
 
Const
 
     maxn = 10;
 
Type
    mtr=array[1..9,1..9]of real;
    
    Data = Real;
 
    //Matrix = Array[1..maxn, 1..maxn] of Data;
 
//    Vector = Array[1..maxn] of Data;
 
    {Schitivaem vremya}
 
var f:text;
     a:mtr;
     m,n:byte;
     
function fGetTime:LongInt;
 
var hr,min,sec,sec_100:word;
 
begin
gettime(hr,min,sec,sec_100);
 
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
 
 
{Процедура ввода расширенной матрицы}
 
 
 
Procedure ReadSystem(var f:text;var a:mtr;var mstr,mcol:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol);
for i:=1 to mstr do
for j:=1 to mcol do
read(f,a[i,j]);
close(f);
end;
 
{ Процедура вывода результата }
 
Procedure WriteX(n :Integer; x: Vector);
 
Var
 
   i: Integer;
 
Begin
 
     For i := 1 to n do
 
         Writeln('x', i, ' = ', x[i]);
 
End;
 
{Метод зейделя }
 
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
 
Var
 
   i, j: Integer;
 
   s1, s2, s, v, m: Data;
 
   before, after:longint;
 
   Begin
   before:=fGettime;
     {Isleduem Sxodimost}
 
     For i := 1 to n do begin
 
         s := 0;
 
         For j := 1 to n do
 
             If j <> i then
 
                s := s + Abs(a[i, j]);
 
         If s >= Abs(a[i, i]) then begin
 
            Seidel := false;
 
            Exit;
 
         end;
 
     end;
 
     Repeat
 
         m := 0;
 
         For i := 1 to n do begin
 
             { Vichislaem summi }
 
             s1 := 0;
 
             s2 := 0;
 
             For j := 1 to i - 1 do
 
                 s1 := s1 + a[i, j] * x[j];
 
             For j := i to n do
 
                 s2 := s2 + a[i, j] * x[j];
 
             { Vichislaem novoe priblizhenie i pogreshnost }
 
             v := x[i];
 
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
 
             If Abs(v - x[i]) > m then
 
                m := Abs(v - x[i]);
 
         end;
 
     Until m < e;
 
     Seidel := true;
     after:=fgetTime;
End;
{ Gaus function }
 
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
 
Var
 
   i, j, k, l: Integer;
 
   q, m, t: Data;
   before, after:longint;
 
Begin
 before:=fGettime;
     For k := 1 to n - 1 do begin
 
         { Ishem Stroku s max elementom d k-om stolbce}
 
         l := 0;
 
         m := 0;
 
         For i := k to n do
 
             If Abs(a[i, k]) > m then begin
 
                m := Abs(a[i, k]);
 
                l := i;
 
             end;
 
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
 
         If l = 0 then begin
 
            Gauss := false;
 
            Exit;
 
         end;
 
         { Menyaem mestom 1-y stroku s K-oi }
 
         If l <> k then begin
 
            For j := 1 to n do begin
 
                t := a[k, j];
 
                a[k, j] := a[l, j];
 
                a[l, j] := t;
 
            end;
 
            t := b[k];
 
            b[k] := b[l];
 
            b[l] := t;
 
         end;
 
         {Preobrazuem matrix}
 
         For i := k + 1 to n do begin
 
             q := a[i, k] / a[k, k];
 
             For j := 1 to n do
 
                 If j = k then
 
                    a[i, j] := 0
 
                 else
 
                      a[i, j] := a[i, j] - q * a[k, j];
 
                 b[i] := b[i] - q * b[k];
 
             end;
 
     end;
 
     { Vichislaem reshenie }
 
     x[n] := b[n] / a[n, n];
 
     For i := n - 1 downto 1 do begin
 
         t := 0;
 
         For j := 1 to n-i do
 
             t := t + a[i, i + j] * x[i + j];
 
         x[i] := (1 / a[i, i]) * (b[i] - t);
 
     end;
 
     Gauss := true;
      after:=fgetTime;
End;
 
Var
 
    n, i: Integer;
 
    a: Matrix;
 
    b, x: Vector;
 
    ch:char;
 
    e: Data;
 
    before, after:longint;
 
label 1,2,3;
 
Begin
 
      ClrScr;
 
 
{--------Vibor knopok-----------------}
writeln('Клавиша <TAB> - Метод Зейделя, Любая другая клавиша - Метод Гауса');
ch:=readkey;
 
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Программа решает СЛУ методом Зейделя');
 
      Writeln;
 
      Writeln('Введите порядок матрицы системы максимум. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Введите точность вычислений');
 
      Repeat
 
             Write('>');
 
             Read(e);
 
      Until (e > 0) and (e < 1);
 
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
 
      ReadSystem;
 
      Writeln;
 
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
 
      For i := 1 to n do
 
          x[i] := 0;
 
      If Seidel(n, a, b, x, e) then begin
 
         Writeln('Результат вычислений по методу Зейделя');
 
         WriteX(n, x);
 
       readln;
       end
 
      else
 
          Writeln('Метод Зейделя не сходится для данной системы');
    after:=fgetTime;
writeln('Функция работалаs: ',(after-before)/1000:0:2,'милисекунд');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
 
2:
 
 Writeln('Решаем СЛУ методом Гауса');
 
      Writeln;
 
      Writeln('Введите порядок матрицы системы максимум. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
 
      ReadSystem;
 
      Writeln;
 
      If Gauss(n, a, b, x) then begin
 
         Writeln('Результат вычислений методом Гауса');
 
         WriteX(n, x);
 
writeln('Функция работала: ',(after-before)/1000:0:2,'sec');
         readln;
      end
 
      else
 
          Writeln('Данную систему невозможно решить методом Гауса');
      Writeln;
3:    readln;
 
End.
Вот попробовала прикрутить процедуру, но ничего не получилось (
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 19:06 8
Цитата Сообщение от Viper1980 Посмотреть сообщение
одна матрица 4*4 вторая 1*4
А в примере вторая 4*1

Добавлено через 4 минуты
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Procedure ReadSystem(var f:text;var a,b:mtr;var mstr,mcol1,mcol2:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol1,mcol2);
for i:=1 to mstr do
for j:=1 to mcol1 do
read(f,a[i,j]);
for i:=1 to mstr do
for j:=1 to mcol2 do
read(f,b[i,j]);
close(f);
end;
файл
4 4 1
1 1 1 1
1 1 1 1
1 1 1 1
1
1
1
1

Добавлено через 2 минуты

Не по теме:

Цитата Сообщение от Viper1980 Посмотреть сообщение
Вот написал процедуру
Цитата Сообщение от Viper1980 Посмотреть сообщение
Вот попробовала прикрутить процедуру
Транссексуал что-ли?

0
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 19:18  [ТС] 9
почему трансексуал?? Девушка я

Добавлено через 7 минут
а как теперь будут выглядеть процедуры Seidel и Gauss, с учётом Ваших изменений. Я прошу прощения за назойливость с паскалем на "ВЫ" ((
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 19:23 10
Цитата Сообщение от Viper1980 Посмотреть сообщение
а как теперь будут выглядеть процедуры Seidel и Gauss
Да так же, они никак не зависят от способа ввода.
Цитата Сообщение от Viper1980 Посмотреть сообщение
Девушка я
Ну так и не пишите
Цитата Сообщение от Viper1980 Посмотреть сообщение
Вот написал процедуру
1
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 19:28  [ТС] 11
вот пример матриц:
Добавлено через 1 минуту
----A-------B
1_2_3_4___1
1_2_3_4___2
1_2_3_4___3
1_2_3_4___4

Добавлено через 1 минуту
Прошу прощения, 1 буковку забыла!
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 19:32 12
Цитата Сообщение от Viper1980 Посмотреть сообщение
вот пример матриц:
Ну запишите матрицы в файл как в моем примере, так же не удобно.
1
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 20:03  [ТС] 13
Спасибо Вам!! Сейчас попробую

Добавлено через 22 минуты
вызываю процедуру:
ReadSystem (f,a,b,mstr,mcol1,mcol2);
****
***
***
Seidel(n,a,b,x,e); Выдаёт вот на этой строчке ошибку - Error 26:Type Mismatch.
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 20:10 14
Скопируйте сюда весь код программы и входной файл.
0
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 20:21  [ТС] 15
Pascal
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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
Uses CRT,DOS;
 
Const
 
     maxn = 10;
 
Type
    mtr=array[1..9,1..9]of real;
 
    Data = Real;
 
    Matrix = Array[1..maxn, 1..maxn] of Data;
 
    Vector = Array[1..maxn] of Data;
 
    {Schitivaem vremya}
 
{var
     a,bb:mtr;
     m,n:byte;}
 
function fGetTime:LongInt;
 
var hr,min,sec,sec_100:word;
 
begin
gettime(hr,min,sec,sec_100);
 
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
 
 
{Процедура ввода расширенной матрицы}
 
 
 
Procedure ReadSystem(var f:text;var a,bb:mtr;var mstr,mcol1,mcol2:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol1,mcol2);
for i:=1 to mstr do
for j:=1 to mcol1 do
read(f,a[i,j]);
for i:=1 to mstr do
for j:=1 to mcol2 do
read(f,bb[i,j]);
close(f);
end;
 
{ Процедура вывода результата }
 
Procedure WriteX(n :Integer; x: Vector);
 
Var
 
   i: Integer;
 
Begin
 
     For i := 1 to n do
 
         Writeln('x', i, ' = ', x[i]);
 
End;
 
{Метод зейделя }
 
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
 
Var
 
   i, j: Integer;
 
   s1, s2, s, v, m: Data;
 
   before, after:longint;
 
   Begin
   before:=fGettime;
     {Isleduem Sxodimost}
 
     For i := 1 to n do begin
 
         s := 0;
 
         For j := 1 to n do
 
             If j <> i then
 
                s := s + Abs(a[i, j]);
 
         If s >= Abs(a[i, i]) then begin
 
            Seidel := false;
 
            Exit;
 
         end;
 
     end;
 
     Repeat
 
         m := 0;
 
         For i := 1 to n do begin
 
             { Vichislaem summi }
 
             s1 := 0;
 
             s2 := 0;
 
             For j := 1 to i - 1 do
 
                 s1 := s1 + a[i, j] * x[j];
 
             For j := i to n do
 
                 s2 := s2 + a[i, j] * x[j];
 
             { Vichislaem novoe priblizhenie i pogreshnost }
 
             v := x[i];
 
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
 
             If Abs(v - x[i]) > m then
 
                m := Abs(v - x[i]);
 
         end;
 
     Until m < e;
 
     Seidel := true;
     after:=fgetTime;
End;
{ Gaus function }
 
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
 
Var
 
   i, j, k, l: Integer;
 
   q, m, t: Data;
   before, after:longint;
 
Begin
 before:=fGettime;
     For k := 1 to n - 1 do begin
 
         { Ishem Stroku s max elementom d k-om stolbce}
 
         l := 0;
 
         m := 0;
 
         For i := k to n do
 
             If Abs(a[i, k]) > m then begin
 
                m := Abs(a[i, k]);
 
                l := i;
 
             end;
 
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
 
         If l = 0 then begin
 
            Gauss := false;
 
            Exit;
 
         end;
 
         { Menyaem mestom 1-y stroku s K-oi }
 
         If l <> k then begin
 
            For j := 1 to n do begin
 
                t := a[k, j];
 
                a[k, j] := a[l, j];
 
                a[l, j] := t;
 
            end;
 
            t := b[k];
 
            b[k] := b[l];
 
            b[l] := t;
 
         end;
 
         {Preobrazuem matrix}
 
         For i := k + 1 to n do begin
 
             q := a[i, k] / a[k, k];
 
             For j := 1 to n do
 
                 If j = k then
 
                    a[i, j] := 0
 
                 else
 
                      a[i, j] := a[i, j] - q * a[k, j];
 
                 b[i] := b[i] - q * b[k];
 
             end;
 
     end;
 
     { Vichislaem reshenie }
 
     x[n] := b[n] / a[n, n];
 
     For i := n - 1 downto 1 do begin
 
         t := 0;
 
         For j := 1 to n-i do
 
             t := t + a[i, i + j] * x[i + j];
 
         x[i] := (1 / a[i, i]) * (b[i] - t);
 
     end;
 
     Gauss := true;
      after:=fgetTime;
End;
 
Var
 
    n,m,mstr,mcol1,mcol2, i: Integer;
 
    a,bb: mtr;
 
    b, x: Vector;
 
    ch:char;
 
    e: Data;
 
    f:text;
 
    before, after:longint;
 
label 1,2,3;
 
Begin
 
      ClrScr;
 
 
{--------Vibor knopok-----------------}
writeln('Клавиша <TAB> - Метод Зейделя, Любая другая клавиша - Метод Гауса');
ch:=readkey;
 
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Программа решает СЛУ методом Зейделя');
 
      Writeln;
 
      Writeln('Введите порядок матрицы системы максимум. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Введите точность вычислений');
 
      Repeat
 
             Write('>');
 
             Read(e);
 
      Until (e > 0) and (e < 1);
 
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
 
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
 
      Writeln;
 
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
 
      For i := 1 to n do
 
          x[i] := 0;
 
      If Seidel(n, a, b, x, e) then begin
 
         Writeln('Результат вычислений по методу Зейделя');
 
         WriteX(n, x);
 
       readln;
       end
 
      else
 
          Writeln('Метод Зейделя не сходится для данной системы');
    after:=fgetTime;
writeln('Функция работалаs: ',(after-before)/1000:0:2,'милисекунд');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
 
2:
 
 Writeln('Решаем СЛУ методом Гауса');
 
      Writeln;
 
      Writeln('Введите порядок матрицы системы максимум. (10)');
 
      Repeat
 
             Write('>');
 
             Read(n);
 
      Until (n > 0) and (n <= maxn);
 
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
 
      ReadSystem;
 
      Writeln;
 
      If Gauss(n, a, b, x) then begin
 
         Writeln('Результат вычислений методом Гауса');
 
         WriteX(n, x);
 
writeln('Функция работала: ',(after-before)/1000:0:2,'sec');
         readln;
      end
 
      else
 
          Writeln('Данную систему невозможно решить методом Гауса');
      Writeln;
3:    readln;
 
End.
Матрица:

4 4 1
1.9 0.3 -0.4 0.9
0.6 -2.7 1.3 -0.6
0.8 -2.2 -3.8 0.5
0.3 1.4 0.6 -2.6
1.3
-0.4
0.6
0.9
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 20:55 16
Вы меня извините но программа длинная, откуда и как вы копируете код что он через строку и при копировании некоторые символы не копируют, возникает куча ошибок, короче я пас.
0
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 21:12  [ТС] 17
Pascal
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
Uses CRT,DOS;
Const
     maxn = 10;
Type
    mtr=array[1..9,1..9]of real;
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;
    {Schitivaem vremya}
{var
     a,bb:mtr;
     m,n:byte;}
function fGetTime:LongInt;
var hr,min,sec,sec_100:word;
begin
gettime(hr,min,sec,sec_100);
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
{Процедура ввода расширенной матрицы}
Procedure ReadSystem(var f:text;var a,bb:mtr;var mstr,mcol1,mcol2:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol1,mcol2);
for i:=1 to mstr do
for j:=1 to mcol1 do
read(f,a[i,j]);
for i:=1 to mstr do
for j:=1 to mcol2 do
read(f,bb[i,j]);
close(f);
end;
{ Процедура вывода результата }
Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;
{Метод зейделя }
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
Var
   i, j: Integer;
   s1, s2, s, v, m: Data;
   before, after:longint;
   Begin
   before:=fGettime;
     {Isleduem Sxodimost}
     For i := 1 to n do begin
         s := 0;
         For j := 1 to n do
             If j <> i then
                s := s + Abs(a[i, j]);
         If s >= Abs(a[i, i]) then begin
            Seidel := false;
            Exit;
         end;
     end;
     Repeat
         m := 0;
         For i := 1 to n do begin
             { Vichislaem summi }
             s1 := 0;
             s2 := 0;
             For j := 1 to i - 1 do
                 s1 := s1 + a[i, j] * x[j];
             For j := i to n do
                 s2 := s2 + a[i, j] * x[j];
             { Vichislaem novoe priblizhenie i pogreshnost }
             v := x[i];
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
             If Abs(v - x[i]) > m then
                m := Abs(v - x[i]);
         end;
     Until m < e;
     Seidel := true;
     after:=fgetTime;
End;
{ Gaus function }
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
   i, j, k, l: Integer;
   q, m, t: Data;
   before, after:longint;
Begin
 before:=fGettime;
     For k := 1 to n - 1 do begin
         { Ishem Stroku s max elementom d k-om stolbce}
         l := 0;
         m := 0;
         For i := k to n do
             If Abs(a[i, k]) > m then begin
                m := Abs(a[i, k]);
                l := i;
             end;
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
         If l = 0 then begin
            Gauss := false;
            Exit;
         end;
         { Menyaem mestom 1-y stroku s K-oi }
         If l <> k then begin
            For j := 1 to n do begin
                t := a[k, j];
                a[k, j] := a[l, j];
                a[l, j] := t;
            end;
            t := b[k];
            b[k] := b[l];
            b[l] := t;
         end;
         {Preobrazuem matrix}
         For i := k + 1 to n do begin
             q := a[i, k] / a[k, k];
             For j := 1 to n do
                 If j = k then
                    a[i, j] := 0
                 else
                     a[i, j] := a[i, j] - q * a[k, j];
                 b[i] := b[i] - q * b[k];
             end;
     end;
     { Vichislaem reshenie }
     x[n] := b[n] / a[n, n];
     For i := n - 1 downto 1 do begin
         t := 0;
         For j := 1 to n-i do
             t := t + a[i, i + j] * x[i + j];
         x[i] := (1 / a[i, i]) * (b[i] - t);
     end;
     Gauss := true;
      after:=fgetTime;
End;
Var
    n,m,mstr,mcol1,mcol2, i: Integer;
    a,bb: mtr;
    b, x: Vector;
    ch:char;
    e: Data;
    f:text;
    before, after:longint;
label 1,2,3;
Begin
      ClrScr;
{--------Vibor knopok-----------------}
writeln('Клавиша <TAB> - Метод Зейделя, Любая другая клавиша - Метод Гауса');
ch:=readkey;
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Программа решает СЛУ методом Зейделя');
      Writeln;
      Writeln('Введите порядок матрицы системы максимум. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('Введите точность вычислений');
      Repeat
             Write('>');
             Read(e);
      Until (e > 0) and (e < 1);
      Writeln;
      Writeln('Введите расширенную матрицу системы');
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
      Writeln;
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
      For i := 1 to n do
          x[i] := 0;
      If Seidel(n, a, b, x, e) then begin
         Writeln('Результат вычислений по методу Зейделя');
         WriteX(n, x);
       readln;
       end
      else
          Writeln('Метод Зейделя не сходится для данной системы');
    after:=fgetTime;
writeln('Функция работалаs: ',(after-before)/1000:0:2,'милисекунд');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
2:
 Writeln('Решаем СЛУ методом Гауса');
      Writeln;
      Writeln('Введите порядок матрицы системы максимум. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('Введите расширенную матрицу системы');
      ReadSystem;
      Writeln;
      If Gauss(n, a, b, x) then begin
         Writeln('Результат вычислений методом Гауса');
         WriteX(n, x);
writeln('Функция работала: ',(after-before)/1000:0:2,'sec');
         readln;
      end
      else
          Writeln('Данную систему невозможно решить методом Гауса');
      Writeln;
3:    readln;
End.
Вот без единого пробела. Ну не отказывайте, помогите пожалуйста ((
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 21:40 18
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Синтаксические ошибки исправил, но нужно разбираться с лишними переменными и логикой программы, но я пас.
Pascal
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
Uses CRT,DOS;
Const
     maxn = 10;
Type
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;
    {Schitivaem vremya}
{var
     a,bb:mtr;
     m,n:byte;}
function fGetTime:LongInt;
var hr,min,sec,sec_100:word;
begin
gettime(hr,min,sec,sec_100);
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
{Процедура ввода расширенной матрицы}
Procedure ReadSystem(var f:text;var a,bb:Matrix;var mstr,mcol1,mcol2:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol1,mcol2);
for i:=1 to mstr do
for j:=1 to mcol1 do
read(f,a[i,j]);
for i:=1 to mstr do
for j:=1 to mcol2 do
read(f,bb[i,j]);
close(f);
end;
{ Процедура вывода результата }
Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;
{Метод зейделя }
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
Var
   i, j: Integer;
   s1, s2, s, v, m: Data;
   before, after:longint;
   Begin
   before:=fGettime;
     {Isleduem Sxodimost}
     For i := 1 to n do begin
         s := 0;
         For j := 1 to n do
             If ji then
                s := s + Abs(a[i, j]);
         If s >= Abs(a[i, i]) then begin
            Seidel := false;
            Exit;
         end;
     end;
     Repeat
         m := 0;
         For i := 1 to n do begin
             { Vichislaem summi }
             s1 := 0;
             s2 := 0;
             For j := 1 to i - 1 do
                 s1 := s1 + a[i, j] * x[j];
             For j := i to n do
                 s2 := s2 + a[i, j] * x[j];
             { Vichislaem novoe priblizhenie i pogreshnost }
             v := x[i];
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
             If Abs(v - x[i]) > m then
                m := Abs(v - x[i]);
         end;
     Until m < e;
     Seidel := true;
     after:=fgetTime;
End;
{ Gaus function }
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
   i, j, k, l: Integer;
   q, m, t: Data;
   before, after:longint;
Begin
 before:=fGettime;
     For k := 1 to n - 1 do begin
         { Ishem Stroku s max elementom d k-om stolbce}
         l := 0;
         m := 0;
         For i := k to n do
             If Abs(a[i, k]) > m then begin
                m := Abs(a[i, k]);
                l := i;
             end;
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
         If l = 0 then begin
            Gauss := false;
            Exit;
         end;
         { Menyaem mestom 1-y stroku s K-oi }
         If lk then begin
            For j := 1 to n do begin
                t := a[k, j];
                a[k, j] := a[l, j];
                a[l, j] := t;
            end;
            t := b[k];
            b[k] := b[l];
            b[l] := t;
         end;
         {Preobrazuem matrix}
         For i := k + 1 to n do begin
             q := a[i, k] / a[k, k];
             For j := 1 to n do
                 If j = k then
                    a[i, j] := 0
                 else
                     a[i, j] := a[i, j] - q * a[k, j];
                 b[i] := b[i] - q * b[k];
             end;
     end;
     { Vichislaem reshenie }
     x[n] := b[n] / a[n, n];
     For i := n - 1 downto 1 do begin
         t := 0;
         For j := 1 to n-i do
             t := t + a[i, i + j] * x[i + j];
         x[i] := (1 / a[i, i]) * (b[i] - t);
     end;
     Gauss := true;
      after:=fgetTime;
End;
Var
    n,m,mstr,mcol1,mcol2, i: Integer;
    a,bb: Matrix;
    b, x: Vector;
    ch:char;
    e: Data;
    f:text;
    before, after:longint;
label 1,2,3;
Begin
      ClrScr;
{--------Vibor knopok-----------------}
writeln('Клавиша  - Метод Зейделя, Любая другая клавиша - Метод Гауса');
ch:=readkey;
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Программа решает СЛУ методом Зейделя');
      Writeln;
      Writeln('Введите порядок матрицы системы максимум. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('Введите точность вычислений');
      Repeat
             Write('>');
             Read(e);
      Until (e > 0) and (e < 1);
      Writeln;
      Writeln('Введите расширенную матрицу системы');
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
      Writeln;
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
      For i := 1 to n do
          x[i] := 0;
      If Seidel(n, a, b, x, e) then begin
         Writeln('Результат вычислений по методу Зейделя');
         WriteX(n, x);
       readln;
       end
      else
          Writeln('Метод Зейделя не сходится для данной системы');
    after:=fgetTime;
writeln('Функция работалаs: ',(after-before)/1000:0:2,'милисекунд');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
2:
 Writeln('Решаем СЛУ методом Гауса');
      Writeln;
      Writeln('Введите порядок матрицы системы максимум. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('Введите расширенную матрицу системы');
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
      Writeln;
      If Gauss(n, a, b, x) then begin
         Writeln('Результат вычислений методом Гауса');
         WriteX(n, x);
writeln('Функция работала: ',(after-before)/1000:0:2,'sec');
         readln;
      end
      else
          Writeln('Данную систему невозможно решить методом Гауса');
      Writeln;
3:    readln;
End.
Добавлено через 6 минут
Это у меня перекодировшик начал врать, некоторые символы пропускает.
Нужно в строке 53
Pascal
1
 If j<>i then
в строке 103
Pascal
1
If l<>k then begin
0
0 / 0 / 0
Регистрация: 06.06.2015
Сообщений: 48
06.06.2015, 21:44  [ТС] 19
СПАСИБО )))
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
06.06.2015, 21:48 20
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Может еще что исковеркал перекодировщик, поэтому вот код в оригинале
Pascal
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
Uses CRT,DOS;
Const
     maxn = 10;
Type
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;
    {Schitivaem vremya}
{var
     a,bb:mtr;
     m,n:byte;}
function fGetTime:LongInt;
var hr,min,sec,sec_100:word;
begin
gettime(hr,min,sec,sec_100);
fgetTime:=longint(hr)*360000+longint(min)*6000+sec*100+sec_100;
end;
{Џа®жҐ¤га* ўў®¤* а*биЁаҐ**®© ¬*ваЁжл}
Procedure ReadSystem(var f:text;var a,bb:Matrix;var mstr,mcol1,mcol2:integer);
var i,j:integer;
begin
assign(f,'matrix.txt');
reset(f);
read(f,mstr,mcol1,mcol2);
for i:=1 to mstr do
for j:=1 to mcol1 do
read(f,a[i,j]);
for i:=1 to mstr do
for j:=1 to mcol2 do
read(f,bb[i,j]);
close(f);
end;
{ Џа®жҐ¤га* ўлў®¤* १г«мв*в* }
Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;
{ЊҐв®¤ §Ґ©¤Ґ«п }
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
Var
   i, j: Integer;
   s1, s2, s, v, m: Data;
   before, after:longint;
   Begin
   before:=fGettime;
     {Isleduem Sxodimost}
     For i := 1 to n do begin
         s := 0;
         For j := 1 to n do
             If j<>i then
                s := s + Abs(a[i, j]);
         If s >= Abs(a[i, i]) then begin
            Seidel := false;
            Exit;
         end;
     end;
     Repeat
         m := 0;
         For i := 1 to n do begin
             { Vichislaem summi }
             s1 := 0;
             s2 := 0;
             For j := 1 to i - 1 do
                 s1 := s1 + a[i, j] * x[j];
             For j := i to n do
                 s2 := s2 + a[i, j] * x[j];
             { Vichislaem novoe priblizhenie i pogreshnost }
             v := x[i];
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
             If Abs(v - x[i]) > m then
                m := Abs(v - x[i]);
         end;
     Until m < e;
     Seidel := true;
     after:=fgetTime;
End;
{ Gaus function }
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
   i, j, k, l: Integer;
   q, m, t: Data;
   before, after:longint;
Begin
 before:=fGettime;
     For k := 1 to n - 1 do begin
         { Ishem Stroku s max elementom d k-om stolbce}
         l := 0;
         m := 0;
         For i := k to n do
             If Abs(a[i, k]) > m then begin
                m := Abs(a[i, k]);
                l := i;
             end;
         { if u vsex stolbcov ot K do N znacheniya v k-om stolbce 0 then sys ne imeet odoznach reshen }
         If l = 0 then begin
            Gauss := false;
            Exit;
         end;
         { Menyaem mestom 1-y stroku s K-oi }
         If l<>k then begin
            For j := 1 to n do begin
                t := a[k, j];
                a[k, j] := a[l, j];
                a[l, j] := t;
            end;
            t := b[k];
            b[k] := b[l];
            b[l] := t;
         end;
         {Preobrazuem matrix}
         For i := k + 1 to n do begin
             q := a[i, k] / a[k, k];
             For j := 1 to n do
                 If j = k then
                    a[i, j] := 0
                 else
                     a[i, j] := a[i, j] - q * a[k, j];
                 b[i] := b[i] - q * b[k];
             end;
     end;
     { Vichislaem reshenie }
     x[n] := b[n] / a[n, n];
     For i := n - 1 downto 1 do begin
         t := 0;
         For j := 1 to n-i do
             t := t + a[i, i + j] * x[i + j];
         x[i] := (1 / a[i, i]) * (b[i] - t);
     end;
     Gauss := true;
      after:=fgetTime;
End;
Var
    n,m,mstr,mcol1,mcol2, i: Integer;
    a,bb: Matrix;
    b, x: Vector;
    ch:char;
    e: Data;
    f:text;
    before, after:longint;
label 1,2,3;
Begin
      ClrScr;
{--------Vibor knopok-----------------}
writeln('Љ«*ўЁи*  - ЊҐв®¤ ‡Ґ©¤Ґ«п, ‹оЎ*п ¤агЈ*п Є«*ўЁи* - ЊҐв®¤ ѓ*гб*');
ch:=readkey;
if ch=#9 then  goto 1 else
                 goto 2;
{----------Vivod Zaidel--------------------------}
1:
    Writeln('Џа®Ја*¬¬* аҐи*Ґв ‘‹“ ¬Ґв®¤®¬ ‡Ґ©¤Ґ«п');
      Writeln;
      Writeln('‚ўҐ¤ЁвҐ Ї®а冷Є ¬*ваЁжл бЁбвҐ¬л ¬*ЄбЁ¬г¬. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('‚ўҐ¤ЁвҐ в®з*®бвм ўлзЁб«Ґ*Ё©');
      Repeat
             Write('>');
             Read(e);
      Until (e > 0) and (e < 1);
      Writeln;
      Writeln('‚ўҐ¤ЁвҐ а*биЁаҐ**го ¬*ваЁжг бЁб⥬л');
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
      Writeln;
      { Predpolagaem nachalnoe priblizhenie ravnim 0}
      For i := 1 to n do
          x[i] := 0;
      If Seidel(n, a, b, x, e) then begin
         Writeln('ђҐ§г«мв*в ўлзЁб«Ґ*Ё© Ї® ¬Ґв®¤г ‡Ґ©¤Ґ«п');
         WriteX(n, x);
       readln;
       end
      else
          Writeln('ЊҐв®¤ ‡Ґ©¤Ґ«п *Ґ б室Ёвбп ¤«п ¤***®© бЁб⥬л');
    after:=fgetTime;
writeln('”г*ЄжЁп а*Ў®в*«*s: ',(after-before)/1000:0:2,'¬Ё«ЁбҐЄг*¤');
goto 3;
{----------------------Vivod GAUS---------------------}
Writeln;
2:
 Writeln('ђҐи*Ґ¬ ‘‹“ ¬Ґв®¤®¬ ѓ*гб*');
      Writeln;
      Writeln('‚ўҐ¤ЁвҐ Ї®а冷Є ¬*ваЁжл бЁбвҐ¬л ¬*ЄбЁ¬г¬. (10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
      Writeln('‚ўҐ¤ЁвҐ а*биЁаҐ**го ¬*ваЁжг бЁб⥬л');
      ReadSystem(f,a,bb,mstr,mcol1,mcol2);
      Writeln;
      If Gauss(n, a, b, x) then begin
         Writeln('ђҐ§г«мв*в ўлзЁб«Ґ*Ё© ¬Ґв®¤®¬ ѓ*гб*');
         WriteX(n, x);
writeln('”г*ЄжЁп а*Ў®в*«*: ',(after-before)/1000:0:2,'sec');
         readln;
      end
      else
          Writeln('„***го бЁб⥬г *Ґў®§¬®¦*® аҐиЁвм ¬Ґв®¤®¬ ѓ*гб*');
      Writeln;
3:    readln;
End.
0
06.06.2015, 21:48
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
06.06.2015, 21:48
Помогаю со студенческими работами здесь

Написать программу для считывания содержимого текстового файла
1 написать программу для считывания содержимого текстового файла. 2 Написать программу для...

Почему после считывания матрицы из файла начинается повторное считывание?
Здравствуйте. ПРоблема такова, считывает размер матрицы и саму матрицу, после успешного считвания...

Программа считывания литерной матрицы из текстового файла не выходит из цикла
Доброго времени суток. Программа считывания литерной матрицы из текстового файла не выходит из...

Поогите написать программу считывания произвольного количества строк из текстового файла
Ну вводиш в программу файл например формата txt. В этом файле что то написанно. И нажимая enter...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru