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
| CONST NmaxP = 10000;
TYPE Ve2D = RECORD x, y: Reel END;
LstVe2D = ARRAY[1..NmaxP] OF Ve2D;
VAR N_Point: Word;
Nuage: LstVe2D;
(*HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
P2 / Migration du nuage
HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH*)
PROCEDURE Aff2b(Nd: Word; Xm: Reel);
CONST C2 = 30; L1 = 20;
BEGIN
E(0010); We(C2, L1 - 1, Nd, 9);
Wr(C2, L1 + 1, Xm, 2118)
END;
PROCEDURE Aff2a;
CONST C1 = 2; L1 = 20;
BEGIN
E(0015); Wt(C1, L1 - 1, 'Nombre de dplacements: Nd = ');
Wt(C1, L1 + 1, 'Abcisse minimale: Xm = ')
END;
PROCEDURE CalcXmin(Np: Word; VAR Xm: Reel; VAR Nu_: LstVe2D);
VAR k: Word; Min, u: Reel;
BEGIN
Min:= 1;
FOR k:= 1 TO Np DO BEGIN
u:= Nu_[k].x; IF (Min>u) THEN Min:= u
END;
Xm:= Min
END;
FUNCTION Dist2(W1, W2: Ve2D): Reel;
VAR X2, Y2: Reel;
BEGIN
X2:= Sqr(W1.x - W2.x); Y2:= Sqr(W1.y - W2.y); Dist2:= X2 + Y2
END;
FUNCTION TestXY(K1, Np: Word; W1: Ve2D; VAR Nu_: LstVe2D): Bool;
CONST D2min = 0.0002;
VAR k: Word; D2: Reel; Test, TestX, TestY: Bool;
BEGIN
Test:= True;
FOR k:= 1 TO Np DO
IF (k<>K1) THEN BEGIN
D2:= Dist2(W1, Nuage[k]);
IF (D2<D2min) THEN Test:= False
END;
TestX:= ((0<W1.x) AND (W1.x<1));
TestY:= ((0<W1.y) AND (W1.y<1));
TestXY:= Test AND (TestX AND TestY)
END;
PROCEDURE Migration(VAR Nu_: LstVe2D);
CONST Rmax = 0.01; D_Pi = 2 * Pi;
VAR k, Ntir: Word; Ndep: Z_32; Ct, Dx, Dy, r, St, t, u, Xmin: Reel;
W: Ve2D; Test: Bool;
BEGIN
Ndep:= 0;
REPEAT
Inc(Ndep); Ntir:= 0;
REPEAT
Inc(Ntir); k:= Random(N_Point); Inc(k);
u:= Random; r:= Rmax * u;
u:= Random; t:= D_Pi * u;
St:= Sin(t); Ct:= Cos(t); u:= Ct + 0.9;
Dx:= r * u; Dy:= r * St;
W.x:= Nu_[k].x + Dx; W.y:= Nu_[k].y + Dy;
Test:= TestXY(k, N_Point, W, Nuage)
UNTIL ((Ntir=20) OR Test);
We(20, 25, Ntir, 6); // Instruction de contrôle, à supprimer
IF Test THEN Nu_[k]:= W;
CalcXmin(N_Point, Xmin, Nuage);
Aff2b(Ndep, Xmin)
UNTIL ((Ndep=30000) OR KeyPressed)
END;
(*HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
P0 / Initialisation du nuage de points
HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH*)
PROCEDURE Init_N(Np, Germe: Z_32; VAR Nu: LstVe2D);
CONST Pzero: Ve2D = (x:0; y:0);
VAR k: Word; u, v: Reel;
BEGIN
RandSeed:= Germe;
FOR k:= 1 TO NmaxP DO
IF (k>Np) THEN Nu[k]:= Pzero
ELSE BEGIN
u:= Random; Nu[k].x:= 0.3 * u;
Nu[k].y:= Random
END
END;
PROCEDURE SaisieNp(VAR Np: Word);
CONST C1 = 2; C2 = C1 + 35; L1 = 2; o = 6;
VAR n: Word;
BEGIN
E(1015); Wt(C1, L1, 'Nombre de points (<=');
E(0012); Write(NmaxP:o); E(0015); Write(' ): Np = '); E(0007);
REPEAT
Rn2(C2, L1, n); We(C2, L1, n, o)
UNTIL ((0<n) AND (n<=NmaxP));
Np:= n; E(0010); We(C2, L1, N_Point, o)
END;; |
Partager