const NbPoints = 3; var ABC : array[0..NbPoints-1] of vector; XYZ : array[0..NbPoints-1] of vector; procedure TForm1.Calcule; var x,M1,M2,M3,MA,MB,MC : vector; mxy : Matrix; i,j,k,n : Integer; ft : TextFile; begin for i:=0 to NbPoints-3 do for j:=i+1 to NbPoints-2 do for k:=j+1 to NbPoints-1 do begin for n:=1 to 3 do Mxy[1,n] := XYZ[i,n]; for n:=1 to 3 do Mxy[2,n] := XYZ[j,n]; for n:=1 to 3 do Mxy[3,n] := XYZ[k,n]; if Det(Mxy,3) <> 0 then begin MA[1] := ABC[i,1]; MA[2] := ABC[j,1]; MA[3] := ABC[k,1]; MB[1] := ABC[i,2]; MB[2] := ABC[j,2]; MB[3] := ABC[k,2]; MC[1] := ABC[i,3]; MC[2] := ABC[j,3]; MC[3] := ABC[k,3]; SystEq(Mxy,MA,M1,3); SystEq(Mxy,MB,M2,3); SystEq(Mxy,MC,M3,3); break; end; end; end;
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questioninterface const MaxN=30;{You can increase it up to 100,not greater but each matrix variable would have size of sqr(MaxN)*sizeof(Real). It is possible to write unit for work with dinamically sized matrices, but i have no needs to do this. You can work with matrices with size less that MaxN, but while you work with this unit you must allocate memory for matrix MaxN x MaxN and leave rest of space unised} type vector=array[1..MaxN]of real; matrix=array[1..MaxN,1..MaxN]of real; sett=set of 1..MaxN; var algebrerr:boolean;
procedure systeq(a:matrix;b:vector;var x:vector;n:integer); var i,j,k:integer; max:real; begin algebrerr:=false; { Conversion matrix to triangle } for i:=1 to n do begin max:=abs(a[i,i]);k:=i; for j:=succ(i) to n do if abs(a[j,i])>max then begin max:=abs(a[j,i]);k:=j end; if max<1E-10 then begin algebrerr:=true;exit end; if k<>i then begin for j:=i to n do begin max:=a[k,j]; a[k,j]:=a[i,j]; a[i,j]:=max; end; max:=b[k]; b[k]:=b[i]; b[i]:=max; end; for j:=succ(i) to n do a[i,j]:=a[i,j]/a[i,i]; b[i]:=b[i]/a[i,i]; for j:=succ(i) to n do begin for k:=succ(i) to n do a[j,k]:=a[j,k]-a[i,k]*a[j,i]; b[j]:=b[j]-b[i]*a[j,i]; end; end; { X calculation} x[n]:=b[n]; for i:=pred(n) downto 1 do begin max:=b[i]; for j:=succ(i) to n do max:=max-a[i,j]*x[j]; x[i]:=max; end; end;
function det(a:matrix;n:integer):real; var i,j,k:integer;d:real; begin for i:=1 to pred(n) do begin if abs(a[i,i])<1E-10 then begin det:=0.0;exit end; for j:=succ(i) to n do begin d:=a[j,i]/a[i,i]; for k:=i to n do a[j,k]:=a[j,k]-d*a[i,k]; end; end; d:=1.0; for i:=1 to n do d:=d*a[i,i]; det:=d; end;