Где ошибка?? время работы процедуры не правильно выходит

78K

24 июня 2014 года

4 / / 18.11.2013

Program P1;
uses utils;
const n=4;e=0.000001;
Type Tm=array[1..20,1..20]of real;
Tn=array[1..20]of real;
DateTime = record
Day, Month, Year, Hour, Minute, Second, Milliseconds: integer;
end;

Var i,j,n2,n1,w,w1,w2,k1,k2,k3:integer; A,A0:Tm; b,Vx:Tn;c: Tm; x,s1,x0,d,z:Tn; t1,t2,t:DateTime;
L,U:Tm;
f,fb,fc:Text;
//Metod Zeidelya
Procedure Zeidel(Var x:Tn;a,c:Tm;s1,x0,d,b,z:Tn);
var i,j,t:integer; sum1,s:real;
begin
for i:=1 to n do
for j:=1 to n do begin
if i=j then c[i,j]:=0 else c[i,j]:=-a[i,j]/a[i,i];
end;
for i:=1 to n do d:=b/a[i,i];
for i:=1 to n do
begin
sum1:=0;
for j:=1 to n do sum1:=sum1+c[i,j];
s1:=sum1; end;
sum1:=s1[1];
for i:=2 to n do
if s1>sum1 then sum1:=s1;
if abs(sum1)<1 then begin
for i:=1 to n do
x0:=d;
for i:=1 to n do begin
s:=0;
for j:=1 to n do
s:=s+c[i,j]*x0[j];
x:=s;end;
for i:=1 to n do
x:=x+d;
t:=0;
repeat
for i:=1 to n do begin
x0:=x;
z:=x0; end;
for i:=1 to n do begin
s:=0;
for j:=1 to n do s:=s+c[i,j]*z[j];
x:=s+d;
z:=x;end;
t:=t+1;
until abs(x-x0)<e;
k1:=t;
end;end;

//Gauss
procedure Zerro; //çàïîëíÿåì ìàòðèöè íóëÿìè è åäåíèöàìè
var //íà÷àëüíàÿ óñòàíîâêà
i,j:byte;
begin
for i:=1 to n do
for j:=1 to n do
begin
L[i,j]:=0;
U[i,j]:=0;
end;
for i:=1 to n do
u[i,i]:=1;
end;
function A_LU(var L,U:Tm):boolean; //Ïîëó÷åíèå ìàòðèö L è U
const
e=0.000001;
var
i,j,k:byte;
s:real;
begin
Zerro;
A_LU:=true;
for i:=1 to n do
for j:=1 to n do
if (i>=j) then begin
s:=0;
for k:=1 to j-1 do
s:=s+L[i,k]*U[k,j];
L[i,j]:=A[i,j]-s;
if (i=j) then
if (abs(L[i,j])<e) then begin
A_LU:=false;
break;
end;
end
else begin
s:=0;
for k:=1 to i-1 do
s:=s+L[i,k]*U[k,j];
U[i,j]:=(A[i,j]-s)/L[i,i]; end;
writeln('Matrica L:');
for i:=1 to n do begin
for j:=1 to n do
write(L[i,j]:2:4,' ');
writeln;
end;
writeln('Matrica U:');
for i:=1 to n do begin
for j:=1 to n do
write(U[i,j]:2:4,' ');
writeln; end;
writeln;
end;
Procedure Gauss(A:Tm; b:Tn; var x:Tn);
var //ðåøåíèå ñèñòåì ìåòîäîì Ãàóññà
y:array[1..50] of real;
i,k:byte;
s:real;
begin
if (A_LU(L,U)) then
begin
for i:=1 to n do
begin
s:=0;
for k:=1 to i-1 do
s:=s+L[i,k]*y[k];
y:=(b-s)/L[i,i];
end;
for i:=n downto 1 do
begin
s:=0;
for k:=i+1 to n do
s:=s+U[i,k]*x[k];
x:=y-s;
end;
writeln('Rewenie X=:');
for i:=1 to n do
write(x,' ');
end
else writeln('Cèñòåìà ðàñõîäèòñÿ!');

end;
procedure peremnoj_matr(vA:TM;var vX:Tn);//ïåðåìíîæåíèå ìàòðèö
var
i,j:byte;
sum:real;
begin
for i:=1 to n do
begin
sum:=0;
for j:=1 to n do begin
sum:=sum+A[i,j]*X[j];
vX:=sum;
end; end;
end;
procedure Prov(var A0:Tm);{ïðèâåäåíèå ê òðåóãîëüíîìó âèäó}
var k,i,j:byte;
r:real;
begin
for k:=1 to 4 do
begin
for j:=k+1 to 5 do
begin
r:=A0[j,k]/A0[k,k];
for i:=k to 4 do
begin
A0[j,i]:=A0[j,i]-r*A0[k,i];
end;
end;
end;
if A0[4,4]=0 then writeln('Systema nesovmestna!!!') else writeln('Systema sovmestna');
end;
procedure Vyvod(var A0:Tm);{âûâîä ðåçóëüòàòà}
var i,j:byte;
begin
writeln('Òðåóãîëüíàÿ ìàòðèöà:');
for i:=1 to 4 do
begin
for j:=1 to 5 do
write(A0[i,j]:6:2);
writeln;
end;
end;

function CurrentDateTime(Hour, Minute, Second, Milliseconds: DateTime): DateTime;
begin
CurrentDateTime(Hour, Minute, Second, Milliseconds);
end;
BEGIN
Writeln('Koefficienti matrici A:');
Assign(f,'Matrici.txt');
Reset(f);
While not eof(f) do begin
for i:=1 to n do begin
for j:=1 to n do
read(f,A[i,j]);
end;
readln(f);
end;
for i:=1 to n do begin
for j:=1 to n do
write(A[i,j],' ');
writeln;
end;
Close(f);
Writeln('Koefficienti B:');
Assign(fb,'B.txt');
Reset(fb);
While not eof(fb) do begin
for i:=1 to n do
read(fb,B);
readln(fb);
end;
for i:=1 to n do
write(B,' ');
writeln;
Close(fb);
writeln('Metod zeidelya: ');
t1:=CurrentDateTime; { writeln('Sec=',t1.Second,' Ms=',t1.Milliseconds);}
w1:=t1.Second*1000+t1.Milliseconds;
Zeidel(x,a,c,s1,x0,d,b,z);
t2:=CurrentDateTime; {writeln('Sec=',t2.Second,' Ms=',t2.Milliseconds); }
w2:=t2.Second*1000+t2.Milliseconds;
w:=w2-w1;
writeln('Vremya raboti proceduri Zeidel=',w,' ms');
writeln('Otvet:');
for i:=1 to n do writeln(x:2:6);
writeln('k=',k1);
writeln('Metod Gaussa:');
t1:=CurrentDateTime; w1:=t1.Second*1000+t1.Milliseconds;
gauss(A,b,x);
t2:=CurrentDateTime;w2:=t2.Second*1000+t2.Milliseconds;
w:=w2-w1; writeln;
writeln('Vremya raboti proceduri Gauss=',w,' ms');
writeln('Proverka B=A*X:');
write('B=');
for i:=1 to n do
write(B:2:4,' '); writeln;
peremnoj_matr(A,vX);
write(' A*X=');
for i:=1 to n do begin
write(vX:2:4,' '); end;
end.

Подписаться на вопросНеобходима регистрация

По порядку

Сначала полезные

Сначала решения

2 ответа

0 спам

326

24 июня 2014 года

sadovoya

757 / / 19.11.2005

Зачем вам эта перегруженная (к тому-же неправильно) версия CurrentDateTime:

Код:

function CurrentDateTime(Hour, Minute, Second, Milliseconds: DateTime): DateTime;
begin

    CurrentDateTime(Hour, Minute, Second, Milliseconds);
end;

Вы ведь пользуетесь стандартной:
t1:=CurrentDateTime;

Нужно учитывать минуты - вполне вероятно попасть на момент смены минут. даже в быстрой программе. Смена часа менее вероятна, но тоже. По-нормальному нужно учитывать все вплоть до года включительно. Правда, некоторые жалуются, что порядок полей структуры DateTime неверный. См. здесь. Не знаю - не проверял. Возможно порядок полей такой -- год, месяц, день и т.д. (что вполне по-американски). Попробуйте функцию потестировать в отдельной программе, что она выдает по каждому полю структуры. Такой тест выявит, что там реально.

Другой вариант -- воспользоваться Windows API ф-цией GetTickCount, если в вашем паскале есть модули для ф-ций Windows (или умеете работать с dll и импортируете из системной дин. библиотеки kernel32.dll сами).

P.S. Не нужно выкладывать весь исходник, а только относящиеся к проблеме части. И если уж выкадываете, то пользуйтесь форматированием (кнопочка {...} в шапке редактора сообщений).

Цитировать

0 спам

247

25 июня 2014 года

wanja

1.2K / / 03.02.2003

Да тупо вычесть из новой даты старую и умножить на 24*60*60, если нужны секунды. А если милисекунды - еще на 1000;

Цитировать

Ваш аккаунт

Последние темы форума

Почтовая рассылка

Где ошибка?? время работы процедуры не правильно выходит

2 ответа