КЛП 2012 февраль. Основы алгоритмизации и языки программирования. Сафьянова / SAOD_LB7

program newLB7;

uses crt;

{вЁЇ ®ЇЁблў ойЁ© ®б­®ў­лҐ Ї а ¬Ґвал ўҐаиЁ­л}
type RefPeak = ^TPeak;
TPeak = record
num: integer; {Ї®ап¤Є®ўл© ­®¬Ґа}
wgn_num: integer; {Ї®ап¤Є®ўл© ­®¬Ґа ЇаЁ ­ е®¦¤Ґ­ЁЁ ¬­®¦Ґбвў  дг­¤ ¬Ґ­в «м­ле жЁЄ«®ў Ја д }
end;

{вЁЇ ®ЇЁблў ойЁ© бЇЁб®Є ўҐаиЁ­}
type RefNode = ^TNode;
TNode = record
peak: RefPeak; {ўҐаиЁ­ }
child: RefNode; {¤®зҐа­пп ўҐаиЁ­  (ў бЇЁбЄҐ Ї®в®¬Є®ў ЁбЇ®«м§гҐвбп Є Є ббл«Є  ­  б«Ґ¤го饣® Ї®в®¬Є )}
sibling: RefNode; {б«Ґ¤гой п ўҐаиЁ­  (ў бЇЁбЄҐ Ї®в®¬Є®ў ЁбЇ®«м§гҐвбп Є Є ббл«Є  ­  ўҐаиЁ­г)}
end;

{вЁЇ ®ЇЁблў ойЁ© бвнЄ ўҐаиЁ­}
type RefStack = ^TStack;
TStack = record
Node: RefNode;
Next: RefStack;
end;

var
FirstNode, CursorNode: RefNode;{б«г¦ҐЎ­л© ЇҐаҐ¬Ґ­­лҐ}
StNode: RefStack;{бвнЄ}
iter: integer; {­®¬Ґа ЁвҐа жЁЁ ЇаЁ Ї®бв஥­ЁЁ ¬­®¦Ґбвў  дг­¤ ¬Ґ­в «м­ле жЁЄ«®ў}
cycle: integer; {Џ®ап¤Є®ўл© ­®¬Ґа дг­¤ ¬Ґ­в «м­®Ј® жЁЄ« }
i: integer;{б«г¦ҐЎ­л© ЇҐаҐ¬Ґ­­лҐ}
memBorrow: longint;{б«г¦ҐЎ­л© ЇҐаҐ¬Ґ­­лҐ}

{ђ Ў®в  б® бвнЄ®¬ ўҐаиЁ­}
{¤®Ў ў«Ґ­ЁҐ ў бвнЄ ­®ў®Ј® н«Ґ¬Ґ­в }
procedure addStack(var Stack: RefStack; Node: RefNode);
var
tmpStack: RefStack;
begin
new(tmpStack);
tmpStack^.Node := Node;
tmpStack^.Next := Stack;
Stack := tmpStack;
end;

{Ё§ў«ҐзҐ­ЁҐ Ё§ бвнЄ  ўҐае­ҐЈ® н«Ґ¬Ґ­в }
procedure decStack(var Stack: RefStack);
var
tmpStack: RefStack;
begin
if Stack^.Next <> nil then begin
tmpStack := Stack;
Stack := Stack^.Next;
dispose(tmpStack)
end else Stack^.Node := nil;
end;

{ЇҐз вм н«Ґ¬Ґ­в®ў бвнЄ  ®в ўҐаиЁ­л Є ЇҐаў®¬г Ё«Ё ®Ја ­ЁзЁў о饬г н«Ґ¬Ґ­вг}
procedure printStack(Stack: RefStack; limitpeak: integer);
var
tmpStack: RefStack;
begin
tmpStack := Stack;
inc(cycle);
write('–ЁЄ« ь',cycle,': ');
while (tmpStack^.Node^.Peak^.Num <> limitPeak) and (tmpStack <> nil) do begin
write('->',tmpStack^.Node^.Peak^.Num);
tmpStack := tmpStack^.Next;
end;
write('->',tmpStack^.Node^.Peak^.Num);
writeln;
end;

{Їа®жҐ¤гал ¤«п а Ў®вл б® бЇЁбЄ®¬ Ё­жЁ¤Ґ­в­®бвЁ}

{дг­ЄжЁп ᮧ¤ ­Ёп ­®ў®© ўҐаиЁ­л}
function createNode(Num: integer): RefNode;
var
tmpNode: RefNode;
begin
new(tmpNode);
new(tmpNode^.peak);
tmpNode^.peak^.num := Num;
tmpNode^.peak^.wgn_num := 0;
new(tmpNode^.child);
tmpNode^.child^.Peak := nil;
tmpNode^.child^.sibling := nil;
tmpNode^.sibling := nil;
createNode := tmpNode;
end;

{Їа®жҐ¤га  ®бў®Ў®¦¤Ґ­Ёп Ї ¬пвЁ § ­пв®© ўҐаиЁ­®©}
procedure disposeNode(var Node: RefNode);
var
tmpPeak: RefPeak;
tmpNode: RefNode;

{Їа®жҐ¤га  ®бў®Ў®¦¤Ґ­Ёп Ї ¬пвЁ § ­пв®© Ї®в®¬Є ¬Ё}
procedure disposeChild(var Node: RefNode);
var
tmpPeak: RefPeak;
tmpNode: RefNode;
begin
if Node^.Peak <> nil then
disposeChild(Node^.child);
tmpPeak := Node^.Peak;
tmpNode := Node^.sibling;
dispose(Node);
end;

begin
if Node^.sibling <> nil then
disposeNode(Node^.sibling);
tmpPeak := Node^.peak;
tmpNode := Node^.child;
dispose(Node);
dispose(tmpPeak);
disposeChild(tmpNode);
end;

{дг­ЄжЁп Ї®ЁбЄ  ўҐаиЁ­л Ї® ­®¬Ґаг}
function getNode(FirstNode: RefNode; Num: integer): RefNode;
var
CursorNode: RefNode;
begin
CursorNode := FirstNode;
while CursorNode <> nil do begin
if CursorNode^.peak^.num = Num then begin
getNode := CursorNode;
exit;
end;
CursorNode := CursorNode^.sibling
end;
end;

{Їа®жҐ¤га  бўп§лў ­Ёп ўҐаиЁ­}
procedure unitedNode(var FirstNode: RefNode; Num1,Num2: integer; ret: boolean);
var
tmpNode1, tmpNode2: RefNode;

{Їа®жҐ¤га  бўп§лў ­Ёп ўҐаиЁ­}
procedure united(Node1, Node2: RefNode);
var
tmpNode, tmpSort, tmpSort1, tmpChild: RefNode;
tmpPeak: RefPeak;
begin
{ᮧ¤ ­ЁҐ ¤®зҐа­ҐЈ® 㧫  Ё бўп§лў ­ЁҐ c ҐЈ® Ї®¬®ймо ¤ўге ўҐаиЁ­}
tmpNode := createNode(0);
tmpPeak := tmpNode^.Peak;
tmpNode^.Peak := Node2^.peak;
tmpNode^.sibling := Node2;
tmpChild := tmpNode^.child;
tmpNode^.child := Node1^.child;
Node1^.child := tmpNode;
{®бў®Ў®¦¤Ґ­ЁҐ Ї ¬пвЁ}
dispose(tmpChild);
dispose(tmpPeak);
end;

begin
{Ї®ЁбЄ 㧫®ў}
tmpNode1 := getNode(FirstNode, Num1);
tmpNode2 := getNode(FirstNode, Num2);
{ᮧ¤ ­ЁҐ ॡа }
united(tmpNode1, tmpNode2);
if ret then united(tmpNode2, tmpNode1);
end;

{Їа®жҐ¤га  Ї®ЁбЄ  ¬­®¦Ґбвў  дг­¤ ¬Ґ­в «м­ле жЁЄ«®ў Ја д }
procedure WGN(Node: RefNode; var Stack: RefStack; var wgn_iter: integer);
var
CursorNode: RefNode;
CursorChild: RefNode;
begin
inc(wgn_iter);
Node^.Peak^.wgn_num := wgn_iter;
addStack(Stack, Node);
CursorChild := Node^.child;
while CursorChild^.Peak <> nil do begin
if CursorChild^.Peak^.wgn_num = 0 then
WGN(CursorChild^.sibling, Stack, wgn_iter)
else if (CursorChild^.Peak^.Num <> Stack^.Next^.Node^.Peak^.Num) and (Node^.Peak^.wgn_num > CursorChild^.Peak^.wgn_num) then
printStack(Stack, CursorChild^.Peak^.Num);
CursorChild := CursorChild^.child;
end;
decStack(Stack);
end;

{Їа®жҐ¤га  ЇҐз вЁ бЇЁбЄ  Ё­жЁ¤Ґ­в­ле ўҐаиЁ­}
procedure printIncedent(FirstNode: RefNode);
var
CursorNode, CursorChild: RefNode;
begin
CursorNode := FirstNode;
while CursorNode <> nil do begin
write(CursorNode^.peak^.num);
CursorChild := CursorNode^.child;
while CursorChild^.Peak <> nil do begin
write('->',CursorChild^.peak^.num);
CursorChild := CursorChild^.child;
end;
CursorNode := CursorNode^.sibling;
writeln;
end;
end;

begin
{®зЁйҐ­ЁҐ нЄа ­ }
clrscr;
memBorrow := memavail;
writeln('>‘®§¤ ­ЁҐ бЇЁбЄ  Ё­жЁ¤Ґ­в­®бвЁ...');
{ᮧ¤ ­ЁҐ ўҐаиЁ­}
CursorNode := createNode(1);
FirstNode := CursorNode;
for i := 2 to 10 do begin
CursorNode^.sibling := createNode(i);
CursorNode := CursorNode^.sibling;
end;
{бўп§лў ­ЁҐ ўҐаиЁ­}
unitedNode(FirstNode,1,4,true);
unitedNode(FirstNode,1,5,true);
unitedNode(FirstNode,2,3,true);
unitedNode(FirstNode,2,5,true);
unitedNode(FirstNode,3,6,true);
unitedNode(FirstNode,4,5,true);
unitedNode(FirstNode,4,7,true);
unitedNode(FirstNode,5,6,true);
unitedNode(FirstNode,5,8,true);
unitedNode(FirstNode,6,9,true);
unitedNode(FirstNode,7,8,true);
unitedNode(FirstNode,8,9,true);
unitedNode(FirstNode,8,10,true);
unitedNode(FirstNode,9,10,true);
{ЇҐз вм бЇЁбЄ  Ё­жЁ¤Ґ­в­®бвЁ}
printIncedent(FirstNode);
writeln('>‡ ­пв® Їа®Ја ¬¬®©: ', memBorrow - memavail,' Ў ©в');
{Ё­ЁжЁ «Ё§ жЁп бвнЄ }
StNode := nil;
iter := 0;
{Ї®ЁбЄ ¬­®¦Ґбвў  дг­¤ ¬Ґ­в «м­ле жЁЄ«®ў ¤«п Ја д }
cycle := 0;
writeln('>Џ®ЁбЄ ¬­®¦Ґбвў  дг­¤ ¬Ґ­в «м­ле жЁЄ«®ў...');
wgn(FirstNode,StNode,iter);
writeln('€в®Ј® ­ ©¤Ґ­® ', cycle,' жЁЄ« (®ў)');
dispose(StNode);
writeln('>Ћбў®Ў®¦¤Ґ­ЁҐ § ­пв®© Ї ¬пвЁ...');
disposeNode(FirstNode);
writeln('>‡ ­пв® Їа®Ја ¬¬®©: ', memavail - memBorrow,' Ў ©в');
Readln;
end.