Форум программистов и сисадминов CyberForum.ru
Вернуться   Форум программистов и сисадминов CyberForum.ru > Форум Форум программистов > Форум Pascal (Паскаль) > Форум Turbo Pascal
Восстановить пароль Регистрация

Ответ Создать новую тему
 
Старый 27.01.2011, 20:17   #1
Владюша
Новичок
 
Регистрация: 27.01.2011
Сообщений: 4
Репутация: 0 (0)
Сохранить результаты в файл / Turbo Pascal

подскажите плиз как в етой проге сохранить результаты(корни уравнения) в файл текстовый.В конце проги я что то намудрил но не пашет...Заранее спасибо!

Код 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
Program Ahb;
var k:integer;
    e:real;
 
type Matrix=array[1..8,1..8] of real;
     Vector=array[1..8] of real;
 
procedure zeidel(n:integer;e:real;a:Matrix;b:Vector;x:Vector);
var i,j:integer;
    s,v,m:real;
begin
 
 
{ Proverka na sovmestnost'}
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
  writeln('Uslovie ne vipolnjaetsja');
  exit
  end;
end;
 
 
{ Vi4isljaem novoe pribligenie i pogreshcnost}
repeat
m:=0;
for i:=1 to n do
 begin
 s:=0;
 for j:=1 to n do
   if i<>j then
     s:=s+a[i,j]*x[j];
 v:=x[i];
 x[i]:=(b[i]-s)/a[i,i];
 if abs(v-x[i])>m then m:=abs(v-x[i]);
 end;
until m<e;
 
writeln('Rezultat');
for i:=1 to n do
writeln('x[',i,']= ',x[i]:0:4);
readln;
 end;
 
Var
n, i,j: Integer;
a: Matrix;
b, x: Vector;
f:text;
Begin
Writeln('Programma reshcenija sistem nelineinih uravnenii metodom Zeidelja');
Writeln;
 
 
 
Write ('Vvedite porjadok matrici (ot 2 do 8)'); readln (k);
Writeln('Vvedite to4nost');
Repeat
Write('>');
Read(e);
Until (e > 0) and (e < 1);
Writeln;
 
Writeln ('Vvedite matricu koeficientov' );
Writeln;
for i:=1 to k do
for j:=1 to k do begin
Write('Vvedite a[',i,',',j,']: ');
Readln(a[i, j]);
end;
Writeln;
 
 
Writeln ('Vvedite matricu svobodnih 4lenov ');
Writeln;
For i := 1 to k do begin
Write('Vvedite b[',i,']: ');
Readln(b[i]);
end;
Writeln;
 
zeidel (k,e,a,b,x);
 
assign(f,'file.txt');Rewrite(f);
writeln(f,'Rezultat');
for i:=1 to n do
Close(f);
end.
Старый 28.01.2011, 09:30   #2
Просто_Юлия
Форумчанин
 
Регистрация: 27.05.2008
Сообщений: 241
Репутация: 133 (45)
Лучшие ответы: 1
Сохранить результаты в файл / Turbo Pascal

Код 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
Program Ahb;
var k:integer;
e:real;
 
type Matrix=array[1..8,1..8] of real;
Vector=array[1..8] of real;
 
procedure zeidel(n:integer;e:real;a:Matrix;b:Vector;var x:Vector);
var i,j:integer;
s,v,m:real;
begin
 
 
{ Proverka na sovmestnost'}
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
writeln('Uslovie ne vipolnjaetsja');
exit
end;
end;
 
 
{ Vi4isljaem novoe pribligenie i pogreshcnost}
repeat
m:=0;
for i:=1 to n do
begin
s:=0;
for j:=1 to n do
if i<>j then
s:=s+a[i,j]*x[j];
v:=x[i];
x[i]:=(b[i]-s)/a[i,i];
if abs(v-x[i])>m then m:=abs(v-x[i]);
end;
until m<e;
 
{writeln('Rezultat');
for i:=1 to n do
writeln('x[',i,']= ',x[i]:0:4);
readln;}
end;
 
Var
i,j: Integer;
a: Matrix;
b, x: Vector;
f:text;
Begin
Writeln('Programma reshcenija sistem nelineinih uravnenii metodom Zeidelja');
Writeln;
 
 
 
Write ('Vvedite porjadok matrici (ot 2 do 8)'); readln (k);
Writeln('Vvedite to4nost');
Repeat
Write('>');
Read(e);
Until (e > 0) and (e < 1);
Writeln;
 
Writeln ('Vvedite matricu koeficientov' );
Writeln;
for i:=1 to k do
for j:=1 to k do begin
Write('Vvedite a[',i,',',j,']: ');
Readln(a[i, j]);
end;
Writeln;
 
 
Writeln ('Vvedite matricu svobodnih 4lenov ');
Writeln;
For i := 1 to k do begin
Write('Vvedite b[',i,']: ');
Readln(b[i]);
end;
Writeln;
 
zeidel (k,e,a,b,x);
 
assign(f,'file.txt');
Rewrite(f);
write(f,'Rezultat');
for i:=1 to k do
  write(f,x[i]);
Close(f);
end.
Другие темы раздела Форум программистов Turbo Pascal. Программирование на языке Turbo Pascal. Помощь студентам и школьникам в решении задач.
Блок-схемы Turbo Pascal
:wall: Програма для вычисления среднего арифметического поизитивных и негативных чисел program Laba4; uses crt; const MaxElements = 20; var arr : array of integer; i : integer; AveragePositive, AverageNegative : Double; CountPositive, CountNegative : integer;
Turbo Pascal Вывести координаты точки (x,y)
Собственно, условие во вложении. Не знаю как сделать. Пример: input: 20 20 40 20 output: 30 10 Помогите, пожалуйста.
Старый 28.01.2011, 09:30
Yandex
Объявления
После регистрации реклама в сообщениях будет скрыта и будут доступны все возможности форума.
Ответ Создать новую тему

Похожие темы
Тема Автор
VBA Открыть файл, разделить ячейку на 1000, сохранить файл, закрыть файл. Как?
Макрос должен запускаться, спрашивать - какой файл ему взять. Открыть его, разделить определенную ячейку на 1000, сохранить файл. Как это сделать? А то я глючу. listname = "Топливо форма" ActiveWorkbook.Sheets(listname).Cells = ActiveWorkbook.Sheets(listname).Cells / 1000 не работает,...
Ник Харди
Visual Basic .NET Как сохранить результаты тестирования при аварийном завершении программы
Возникла проблема. Во время тестирования отключается электричество и тем, кто не закончил тестирование приходиться тестироваться заново. Как сохранить весь процесс если возникнут какие ни будь неполадки. Есть идеи???
ZAM88
VBA сохранить результаты в ехел 2003
objxl = getobject ("...1.xls") objxl2=getobject ("...2.xls") ..... body (вычисления с разл данными с разл листов 1.xls,все работает) .... запись результатов в 2.xls примерно objxl2.worksheets("result").cells(h,5)=n значение в лист записывается.
freefire
C# под Web, ASP.NET Неободимо результаты нескольких запросов сохранить в один xml файл
neobhodimo resultati neskolkih zaprosov v database, tipa 'select' sovhranit v odin xml file nu odin zapros sohranit mozhno: set cnn=createobject('adodb.connection') cnn.open ... set rs=createobject('adodb.recordset') rs.Open 'SELECT handle FROM personal', cnn rs.save 'C:111.xml',1
bakss
PHP для начинающих Можно,ли сохранить результаты запроса(recordset) в переменной сеанса?
Можно,ли сохранить результаты запроса(recordset) в переменной сеанса
laptop
Опции темы

Текущее время: 20:09. Часовой пояс GMT +4.

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.7 PL3
Copyright ©2000 - 2014, vBulletin Solutions, Inc.