§2. Рекурсивный способ построения простой замкнутой ломаной

Идея: Чтобы перебрать все возможные способы построения простой замкнутой прямой мы воспользовались следующим алгоритмом построения:

1. Зафиксировали одну из n точек, т.к. не имеет значение, какая точка будет начальной т.к ломаная замкнутая;

2. Соединяя зафиксированную точку с одной из незанятых точек, получаем первую сторону ломаной.

3. Затем соединение продолжаем рекурсивно полным перебором всех незанятых точек, при условиях:

Ш Новую точку можно соединить с последней присоединённой точкой, если отрезок, соединяющий эти точки, не пересекает ни одну из уже построенных сторон ломаной;

Ш Продолжаем построение до тех пор, пока есть незадействованные точки,

Ш Если свободных точек нет и отрезок, соединяющий последнюю присоединенную точку с первой, не пересекает ни одну из сторон построенной ломаной то, построенная ломаная и этот отрезок будут образовывать искомую замкнутую ломаную.

4. Возвращаемся к пункту 2 до тех пор пока не будут перебраны все незанятые точки.

Программа

Uses crt;

Const n=9 ;{Количество точек}

m=400;{}

Type tochka=record

x,y,r:real;

n:word;

end;

Mass=array[0..n] of tochka;

Var sch:word;

number:text;

Procedure Sozd_t(Var MT:Mass; n,m:Word);

Var i:word;

Begin randomize;

For i:=1 to n do

begin

MT[i].x:=random(m);

MT[i].y:=random(m);

MT[i].n:=i;

end;

End;

Procedure Sdvyg(Var MT:Mass;n1,n2:word);{n1- n2-}

Var i:word;

Begin

For i:=n1 to n2-1 do MT[i]:=MT[i+1];

MT[n2].x:=1000; MT[n2].y:=1000;

End;

{Сохраняем полученную ломаную}

Procedure Save(MT:mass);

Var i:word;

st1,st2:string[n];

Begin

sch:=sch+1; st2:=;

For i:=1 to n do

begin

Write(MT[i].n, );

str(MT[i].n,st1);

st2:=st2+st1;

end;

Writeln(---,sch,---);

Writeln(number,st2);

readkey;

End;

Procedure Rekurs(MT:Mass;Kol:word;T:word);

Var i,j,g:word;

s:boolean;

Begin

MT[0]:=MT[t];

Sdvyg(MT,t,kol);

MT[kol]:=MT[0];

Kol:=kol-1;

IF kol>0 then

For j:=1 to kol do

begin s:=true;

for i:=kol+1 to n-1 do

if Peres(MT[j],MT[kol+1],MT[i],MT[i+1]) then s:=false;

if s then Rekurs(MT,kol,j)

end

ELSE begin s:=true;

For g:=1 to n-1 do

if Peres(MT[1],MT[n],MT[g],MT[g+1]) then s:=false;

if s then Save(MT);

end;

End;

Procedure Recurs_Soed(MT:Mass);

Var v:word;

Begin

For v:=1 to n-1 do Rekurs(MT,n-1,v)

End;

Procedure Proseivanie(var f1,f2:text);

Var st1,st2,st3:string[n];

S:boolean;

i,j,v:byte;

Begin v:=1;

Read(f1,st1);

Writeln(f2,st1);

While not eof(f1) do

begin

Readln(f1,st1);

reset(f2);{гбв­ў"ЁўҐ¬ Єгаб®Є ў ­з"® д©"}

s:=true;

st3[n]:=st1[n];

for i:=1 to n-1 do st3[i]:=st1[n-i];

{Џа®ўҐаЄ ­ б®ўЇ¤Ґ­ЁҐ st1 б 㦥 §ЇЁб­­л¬Ё ў f2}

While not eof(f2) and s do

begin

Readln(f2,st2);

j:=0;

For i:=1 to n do

if (st2[i]=st1[i]) or (st2[i]=st3[i]) then j:=j+1;

if j=n then s:=false;

end;

if s then begin Append(f2); Writeln(f2,st1); v:=v+1 end;

end;

writeln;

writeln(---,v,---);

End;

Var MT:mass;

k,ch:word;

Loman:text;

BEGIN

clrscr;

sch:=0;

Sozd_T(MT,n,m);

assign(number,number.txt);

Rewrite(number);

Recurs_Soed(MT);

readln;

Close(number);

Reset(number);

assign(Loman,Loman.txt);

Rewrite(Loman);

Proseivanie(Number,Loman);

Close(Number);

Close(Loman);

readln;

END.