п.2 Реализация на языке Паскаль
uses crt,graph;
Const n=10; {Задаём количество точек}
m=400;{Длина стороны квадрата на котором расположены точки}
Type
tochka=record
x,y,r:real;
end;
Mass=array[0..n] of tochka;
Var sch:word; {Счетчик точек}
{Задает произвольным образом n точек в квадрате со стороной m }
Procedure Sozd_t(Var A:Mass; n,m:Word);
Var i:word;
Begin randomize;
For i:=1 to n do
begin
A[i].x:=random(m);
A[i].y:=random(m);
end;
End;
{Рисует отрезок ВС}
Procedure Lin(B,C:tochka);
Begin
Line(Round(B.x),Round(B.y),Round(C.x),Round(C.y))
End;
{Определяет расстояние между точками}
Function R_TT(Var A,B:tochka):real;
Begin R_TT:=Sqrt(sqr(A.x-B.x)+sqr(A.y-B.y));
End;
{Определяет расстояние между i-ой точкой и другими}
Procedure Rasst_TT(Var A:Mass; i,n:word);
Var j:word;
Begin
For j:=1 to n do
A[j].r:=R_TT(A[i],A[j])
End;
{Устраняет отрицательные значения расстояния}
Procedure absal(Var A:Mass; n1,n2:word);
Var i:word;
Begin
For i:=n1 to n2 do A[i].r:=abs(A[i].r)
End;
{Ищет номер ближайшей точки к i-ой}
Function PoiskNT(Var A:Mass; n1,n2:word):word;
var i,j:word;
Begin j:=n1;
While A[j].r<0 do j:=j+1;
For i:=n1 to n2 do
if (A[i].r>0) and (A[i].r<A[j].r) then j:=i;
PoiskNT:=j;
End;
{Сдвигает точки в массиве на 1 позицию влево начиная с n1 до n2}
Procedure Sdvyg(Var A:Mass;n1,n2:word);
Var i:word;
Begin
For i:=n1 to n2-1 do A[i]:=A[i+1];
A[n2].x:=1000; A[n2].y:=1000;
End;
{Ищет основание перпендикуляра опущенного из точки Т на прямую проходящую через точки В иС}
Procedure Osn(T,B,C:tochka;var O:tochka);
Var k,b2,a1,b1,c1:real;
Begin
If (B.x=C.x) then begin O.x:=B.x; O.y:=T.y end
else begin
k:=(B.y-C.y)/(B.x-C.x);
b2:=B.y-k*B.x;
a1:=2*(B.x-C.x)+2*k*(B.y-C.y);
b1:=2*b2*(B.y-C.y)+(sqr(C.x)-sqr(B.x))+(sqr(C.y)-sqr(B.y));
c1:=sqr(B.x-T.x)+sqr(B.y-T.y)-sqr(C.x-T.x)-sqr(C.y-T.y);
O.x:=(-c1-b1)/a1;
O.y:=k*O.x+b2;
end;
End;
{Функция истина если три точки лежат на одной прямой}
FUNCTION S_3(T,B,C:tochka):Boolean;
{Функция истина если точка Т принадлежит отрезку ВС}
Function Prin(T,B,C:tochka):boolean;
Begin
If S_3(T,B,C) then
if (((B.x<=T.x)and(T.x<=C.x)) or ((C.x<=T.x)and(T.x<=B.x))) and
(((B.y<=T.y)and(T.y<=C.y)) or ((C.y<=T.y)and(T.y<=B.y)))
then Prin:=true
else Prin:=false
else Prin:=false
End;
{Возвращает расстояние между точкой и отрезком ВС}
Function R_TO(T,B,C:tochka):real;
Var T1:tochka;
Begin
Osn(T,B,C,T1);
If prin(T1,B,C) then R_TO:=R_tt(T1,T)
else if R_tt(T,B)<=R_tt(T,C) then R_TO:=R_tt(T,B)
else R_TO:=R_tt(T,C)
End;
{Строит ломанную через точки с номера n1 до n2}
Procedure Postr(A:Mass;n1,n2:word);
Var i:word;
Begin
for i:=n1 to n2 do begin PieSlice(Round(A[i].x), Round(A[i].y), 0, 360, 2);
if i=n2 then
Line(Round(A[n2].x),Round(A[n2].y),Round(A[n1].x),Round(A[n1].y))
else Line(Round(A[i].x),Round(A[i].y),Round(A[i+1].x),Round(A[i+1].y))
end;
End;
{Выдает информацию о количестве задействованных точек}
Procedure Schet;
Var st:string;
code:integer;
Begin sch:=sch+1;
str(sch,st);
OuttextXY(600,100,st)
End;
{Истина если отрезки [AB] и [CD] имеют общие точки за исключением случаев 1) если отрезки совпадают;
2) если один конец отрезка совпадает с одним из концов другого отрезка и других общих точек нет.}
Function Peres(A,B,C,D:tochka):boolean;
Var A:mass;
B,C:tochka;
Danger,s1,s2,s3,s4:boolean;
T,OL,O,OK,OKP,i,j,t1,t2,o1,o2:word;
grDriver : Integer;
grMode : Integer;
ErrCode : Integer;
st:string;
BEGIN
sch:=0;
grDriver:=Detect;
InitGraph(grDriver, grMode, );
ErrCode:=GraphResult;
clrScr;
Sozd_t(A,n,m); {‡¤Ґ¬ Їа®Ё§ў®"м® в®зЄЁ }
Rasst_TT(A,n);
{`®§¤Ґ¬ ЇҐаўл© ваҐгЈ®"мЁЄ}
A[0]:=A[1];
Sdvyg(A,1,n);
A[n]:=A[0];
i:=PoiskNT(A,1,n-1);
A[0]:=A[i];{€йҐ¬ Ў"Ё¦йЁо в®зЄг Є T}
Sdvyg(A,i,n-1);
Sdvyg(A,n-1,n);
A[n]:=A[0];
i:=Poisknt(A,1,n-2);{€йҐ¬ 2-о Ў"Ё¦йоо в®зЄг Є T}
{Џа®ўҐаЁ¬ "Ґ¦в "Ё ®¤®© Їаאַ©}
While S_3(A[i],A[n-1],A[n]) do {!!!!}
begin A[i].r:=-A[i].r; i:=Poisknt(A,1,n-2) end;
A[0]:=A[i];
Sdvyg(A,i,n-2);
Sdvyg(A,n-2,n);
A[n]:=A[0];
textcolor(1);
t1:=1; t2:=n-3;
o1:=n-2; o2:=n;
ClearDevice;
Postr(A,o1,o2);
readkey;
sch:=3;
Repeat
Absal(A,1,n);
{Ќе®¤Ё¬ Ў"Ё¦йЁо в®зЄг ў бв. Є®"мжҐ}
T:=Poisknt(A,t1,t2);
{‡ЇЁб뢥¬ аббв®пЁҐ ®в в®зЄЁ ¤® ®в१Є ў "Ґўл© Є®Ґж}
For i:=o1 to o2-1 do
A[i].r:=R_TO(A[T],A[i],A[i+1]);
A[o2].r:=R_TO(A[T],A[O2],A[O1]);
{€йҐ¬ г¦л© ®в१®Є}
j:=t1-1;
Repeat
{§ЇгбвЁ¬ бзҐвзЁЄ Ї®ўв®аҐЁ©}
j:=j+1;
{€йҐ¬ Ў"Ё¦йЁ© ®в१®Є}
O:=O1;
while A[O].r<0 do O:=O+1;
For i:=O1 to O2 do
if (A[i].r>0) and (A[i].r<A[O].r) then O:=i;
{[O,O+1] Ў"Ё¦йЁ© ®в१®Є}
{ЋЇаҐ¤Ґ"塞 "ЁзЁҐ Ї"®еЁе ваҐгЈ®"мЁЄ®ў}
if O=O2 then Ok:=O1 else Ok:=O+1;
Cleardevice;
setcolor(blue);
postr(A,o1,o2);
PieSlice(Round(A[o1].x), Round(A[o1].y), 0, 360, 5);
PieSlice(Round(A[o2].x), Round(A[o2].y), 0, 360, 5);
PieSlice(Round(A[t].x), Round(A[t].y), 0, 360, 3);
setcolor(15);
lin(A[t],A[o]);lin(A[t],A[ok]);
setcolor(4);
lin(A[o],A[ok]);
readkey;
s4:=false;
For i:=o1 to o2-1 do
if Peres(A[T],A[O],A[i],A[i+1]) or
Peres(A[T],A[Ok],A[i],A[i+1]) then begin s4:=true; setcolor(green); lin(A[i],A[i+1]);
str(A[i].x,st); OuttextXY(400,300,st);
str(A[i].y,st); OuttextXY(400,310,st);
str(A[i+1].x,st); OuttextXY(400,320,st);
str(A[i+1].y,st); OuttextXY(400,330,st);
str(A[T].x,st); OuttextXY(400,340,st);
str(A[T].y,st); OuttextXY(400,350,st);
str(A[O].x,st); OuttextXY(400,360,st);
str(A[O].y,st); OuttextXY(400,370,st);
str(A[Ok].x,st); OuttextXY(400,380,st);
str(A[Ok].y,st); OuttextXY(400,390,st);
readkey end;
if Peres(A[T],A[O],A[o2],A[o1]) or
Peres(A[T],A[Ok],A[o2],A[o1]) then begin s4:=true; setcolor(green); lin(A[i],A[i+1]);readkey end;
if s4 then A[O].r:=-A[O].r;
until (A[O].r>0) {or (j=t2)};
if A[O].r>0 then
Begin {ЏҐаҐ¬ҐйҐ¬ в®зЄг ў ®ў®Ґ Є®"мж®}
ClearDevice;
setcolor(4);
PieSlice(Round(A[o1].x), Round(A[o1].y), 0, 360, 3);
setcolor(1);
Postr(A,o1,o2);
PieSlice(Round(A[t].x), Round(A[t].y), 0, 360, 5);
Lin(A[o],A[ok]);
delay(3000);
A[0]:=A[T];
Sdvyg(A,t,t2);
O1:=t2;
t2:=t2-1;
Sdvyg(A,O1,O); {Ћбў®Ў®¤Ё"Ё п祩Єг ¤"п ®ў®© в®зЄЁ}
A[O]:=A[0];
schet;
readkey;
End
else Danger:=true;
Cleardevice;
Postr(A,o1,o2);
Until Danger or (t2=0);
Textcolor(4);
Writeln(ђҐ§г"мвв аЎ®вл Їа®Ја¬¬л);
If Danger then begin CloseGraph; Writeln(`®Ґ¤ҐЁвм в®зЄЁ Ґў®§¬®¦®); readln; end
else begin ClearDevice;
Postr(A,o1,o2);
readkey;
Closegraph;
end;
END.
- Введение
- Глава 1
- §1. Понятие ломаной
- §2. Прямая на плоскости.
- Глава 2
- Введение: Перечень основных процедур и функций, используемых в программах
- §1. Function Peres, Блок Схема
- п.2 Function Peres, на языке Turbo Pascal
- §2. Рекурсивный способ построения простой замкнутой ломаной
- §3. Верхняя оценка количества способов построения ПЗЛ
- §4. Построения простой замкнутой ломаной методом "Треугольника"
- п.1 Идея метода
- п.2 Реализация на языке Паскаль
- Список литературы