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
|
type xy = record x,y : integer end;
const N=5; // 5 points
//les données
const Ai : array[1..N] of xy = ((x:86;Y:5), (X:87;Y:4), (X:88;y:2), (X:89; Y:1), (X:88;Y:3));
//tableau pour la solution
var Si : array[1..N] of xy;
var det,p,q, somme_X2, Somm_X, Somme_XY, Somme_Y : double; i : integer; slope_positif : boolean;
//fonction dour ordonner les points en x puis en 2eme priorité en y en fonction de la pente
function Less( A, B : xy) : boolean;
begin
if A.x < B.x then
Less:=true
else
if A.x > B.x then
Less:=false
else
begin
if slope_positif then
Less:=A.y < B.y
else
Less:=A.y > B.y
end;
end;
//méthode récurante de classement ( attention avec de gros tableaux, cette méthode peut conduire à des problèmes de stack)
procedure classer(l,r : integer );
var pivot,H : xy; i,j : integer;
begin
i := l;
j := r;
pivot:=Si[(l+r) shr 1];
repeat
while Less(Si[i],pivot) do inc(i);
while Less(pivot,Si[j]) do dec(j);
if i <= j then
begin
H:=Si[i];
Si[i]:=Si[j];
Si[j]:=H;
inc(i);
dec(j)
end
until i > j;
if l < j then classer(l,j);
if i < r then classer(i,r)
end;
var t : textfile; OK : boolean;vect : xy;
procedure find_solution;
begin
somme_X2:=0;
Somm_X:=0;
Somme_XY:=0;
Somme_Y:=0;
for i:=1 to N do with Ai[i] do
begin
Si[i]:=Ai[i]; // on met dans la solution provisoire les datas
Somm_X:=Somm_X + x; // sommeX
somme_X2:=somme_X2 + sqr(x); // somme X^2
Somme_Y:=Somme_Y + y; // somme y
Somme_XY:=Somme_XY + x*y; // somme x*y
end;
det:= somme_X2*N-sqr(Somm_X); // déterminant du système
if abs(det) > 1e-100 then // le déterminant pourait être nul pour une droite verticale ou des points parfaitement équirépartis sur un cercle par exemple
begin
p:= (Somme_XY*N-Somm_X*Somme_Y) / det;
//on a pas besoin de q ici
slope_positif:= p>0; // true si la droite est de pente >=0
end;
classer(1,N);
i:=1;
repeat
inc(i);
vect.x:=Si[i].x - Si[i-1].x;
vect.y:=Si[i].y - Si[i-1].y;
if abs(vect.x)=1 then OK:= abs(vect.y) <=1 // si points adjacents OK=true
else
if
vect.x=0 then OK :=abs(vect.y) =1// si points adjacents OK=true
else
OK:=false; // la solution présente une discontinuité => mettre OK= false
until (i=N) or not OK; // stopper si on a fini de tester les points ou si une discontiniité est trouvée
//écrire la solution dans un fichier ASCII
assignfile(t,'solution.txt');
rewrite(t);
writeln(t,'Pente ',p);
writeln(t,'Solution OK : ' + IntToStr(Ord(OK)));
for i:=1 to n do with Si[i] do writeln(t,x,' ',y);
closefile(t);
end; |
