Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
0 / 0 / 1
Регистрация: 23.10.2013
Сообщений: 50
1

Перевести код с Turbo Pascal

11.03.2014, 20:19. Показов 760. Ответов 1
Метки нет (Все метки)

помогите перенести с Turbo Pascal на Pascal ABC
метод полной релаксации решения СЛАУ
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
uses crt;
 
const
   MAX_SIZE=20;                          {максимальный размер матрицы}
 
type
   TMatrix= array [1..MAX_SIZE] of array [1..MAX_SIZE] of double;
   TVector= array [1..MAX_SIZE] of double;
 
var
   i, j: integer;
   a: TMatrix;                           
   f: TVector;                            {вектор правой части}
   res: TVector;                          {вектор решения системы}
   size: integer;                         {размерность системы}
   accuracy: double;                      {точность вычислений}
   max_step: longint;                     {максимальное число шагов}
   data_file: text;                      
 
 
{эвклидова норма вектора}
function norma(var r: TVector; size: integer): double;
var
   res: double;
 
begin
   for i:=1 to size do begin
      res:=res+sqr(r[i]);
   end;
 
   norma:=sqrt(res);
end;
 
 
{копирование вектора}
procedure copyVect(var v: TVector;
                   var r: TVector;
                   size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v[i];
   end;
end;
 
 
{произведение матрицы на вектор}
procedure multMatrVect(var m: TMatrix;
                       var v: TVector;
                       var r: TVector;
                       size: integer);
var
   i, j: integer;
   res: double;
 
begin
   for i:=1 to size do begin
      res:=0;
      for j:=1 to size do begin
         res:=res+m[i,j]*v[j];
      end;
      r[i]:=res;
   end;
end;
 
 
{сумма векторов}
procedure addVect(var v1: TVector;
                  var v2: TVector;
                  var r: TVector;
                  size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v1[i]+v2[i];
   end;
end;
 
 
{разность векторов}
procedure subVect(var v1: TVector;
                  var v2: TVector;
                  var r: TVector;
                  size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v1[i]-v2[i];
   end;
end;
 
 
{решение системы}
procedure linearSolveFullRelax(var a: TMatrix;
                               var f: TVector;
                               var res: TVector;
                               size: integer;
                               accurancy: double);
var
   x, r, alpha, t: TVector;
   k, max_step: longint;
 
begin
   k:=0;
   max_step:=10000;
   copyVect(f,x,size);
 
   repeat
      multMatrVect(a,x,t,size);
      subVect(f,t,r,size);
 
      for i:=1 to size do begin
         alpha[i]:=r[i]/a[i,i];
      end;
 
      addVect(x,alpha,t,size);
      copyVect(t,x,size);
 
      k:=k+1;
   until (k>=max_step) or (norma(r,size)<=accuracy);
 
   writeln('Число шагов: ',k);
 
   if(k=max_step) then begin
      writeln('Заданная точность не достигнута');
   end;
 
   copyVect(x,res,size);
end;
 
 
begin
   accuracy:=1e-7;
   max_step:=10000;
 
   clrscr;
       assign(data_file, 'a.txt');
   reset(data_file);
   read(data_file, size);
 
   for i:=1 to size do begin
      for j:=1 to size do begin
         read(data_file, a[i,j]);
      end;
      read(data_file, f[i]);
   end;
 
   close(data_file);
 
   writeln('Расширенная матрица системы:');
   for i:=1 to size do begin
      for j:=1 to size do begin
         write(a[i,j]:14:6);
      end;
      writeln(f[i]:14:6);
   end;
   writeln;
 
   linearSolveFullRelax(a,f,res,size,accuracy);
 
   writeln('Результат:');
   for i:=1 to size do begin
      writeln(res[i]:14:6);
   end;
   writeln;
   readkey;
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
11.03.2014, 20:19
Ответы с готовыми решениями:

Нужно перевести код из Turbo Pascal в Pascal ABC
Program n5; { Задача. Описать функцию less(f) от непустого файла f ...

Перевести код с Turbo Pascal
program format; uses crt; var filename,slovo,stroka:string; f:text; dlina,otstup,i:byte;...

Перевести код с Turbo Pascal
помогите, люди добрые. вот текст программы: program kr5; const max_student = 30; type ...

Перевести из Turbo Pascal в Pascal ABC
Добрый вечер. Необходимо перевести этот код из Turbo Pascal в Pascal ABC. Заранее спасибо. uses...

__________________
1
Модератор
63356 / 47058 / 32437
Регистрация: 18.05.2008
Сообщений: 114,065
11.03.2014, 21:30 2
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
uses crt;
 
const
   MAX_SIZE=20;                          {максимальный размер матрицы}
 
type
   TMatrix= array [1..MAX_SIZE] of array [1..MAX_SIZE] of real;
   TVector= array [1..MAX_SIZE] of real;
 
var
   i, j: integer;
   a: TMatrix;
   f: TVector;                            {вектор правой части}
   res: TVector;                          {вектор решения системы}
   size: integer;                         {размерность системы}
   accuracy: real;                      {точность вычислений}
   max_step: longint;                     {максимальное число шагов}
   data_file: text;
 
 
{эвклидова норма вектора}
function norma(var r: TVector; size: integer): real;
var
   res: real;
 
begin
   for i:=1 to size do begin
      res:=res+sqr(r[i]);
   end;
 
   norma:=sqrt(res);
end;
 
 
{копирование вектора}
procedure copyVect(var v: TVector;
                   var r: TVector;
                   size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v[i];
   end;
end;
 
 
{произведение матрицы на вектор}
procedure multMatrVect(var m: TMatrix;
                       var v: TVector;
                       var r: TVector;
                       size: integer);
var
   i, j: integer;
   res: real;
 
begin
   for i:=1 to size do begin
      res:=0;
      for j:=1 to size do begin
         res:=res+m[i][j]*v[j];
      end;
      r[i]:=res;
   end;
end;
 
 
{сумма векторов}
procedure addVect(var v1: TVector;
                  var v2: TVector;
                  var r: TVector;
                  size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v1[i]+v2[i];
   end;
end;
 
 
{разность векторов}
procedure subVect(var v1: TVector;
                  var v2: TVector;
                  var r: TVector;
                  size: integer);
var
   i: integer;
begin
   for i:=1 to size do begin
      r[i]:=v1[i]-v2[i];
   end;
end;
 
 
{решение системы}
procedure linearSolveFullRelax(var a: TMatrix;
                               var f: TVector;
                               var res: TVector;
                               size: integer;
                               accurancy: real);
var
   x, r, alpha, t: TVector;
   k, max_step: longint;
 
begin
   k:=0;
   max_step:=10000;
   copyVect(f,x,size);
 
   repeat
      multMatrVect(a,x,t,size);
      subVect(f,t,r,size);
 
      for i:=1 to size do begin
         alpha[i]:=r[i]/a[i][i];
      end;
 
      addVect(x,alpha,t,size);
      copyVect(t,x,size);
 
      k:=k+1;
   until (k>=max_step) or (norma(r,size)<=accuracy);
 
   writeln('Число шагов: ',k);
 
   if(k=max_step) then begin
      writeln('Заданная точность не достигнута');
   end;
 
   copyVect(x,res,size);
end;
 
 
begin
   accuracy:=1e-7;
   max_step:=10000;
 
   clrscr;
       assign(data_file, 'a.txt');
   reset(data_file);
   read(data_file, size);
 
   for i:=1 to size do begin
      for j:=1 to size do begin
         read(data_file, a[i][j]);
      end;
      read(data_file, f[i]);
   end;
 
   close(data_file);
 
   writeln('Расширенная матрица системы:');
   for i:=1 to size do begin
      for j:=1 to size do begin
         write(a[i][j]:14:6);
      end;
      writeln(f[i]:14:6);
   end;
   writeln;
 
   linearSolveFullRelax(a,f,res,size,accuracy);
 
   writeln('Результат:');
   for i:=1 to size do begin
      writeln(res[i]:14:6);
   end;
   writeln;
end.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
11.03.2014, 21:30

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Переписать код из Turbo Pascal в pascal ABC
очень плохо знаю Turbo Pascal, а времени на изучение нет, а его надо переписать в Pascal ABC, буду...

Переписать код из Turbo Pascal в Pascal ABC
Программа 1: program zadacha; uses crt, graph; const m=150; var gd,gm,i,j,s1,s2,c: integer;...

Переписать код из Turbo Pascal в Pascal ABC
Переписать код из Turbo Pascal в pascal ABCprogram zadacha; uses crt, graph; const m=50; var...

Переписать код из Turbo Pascal в Pascal ABC
Переписать код из Turbo Pascal в Pascal ABCprogram zadacha; uses crt, graph; const m=150; var...


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

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

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