Программа 1двусвязный. pas

Программа 1двусвязный. pas

type

  PMyType = ^TMyType;

  TMyType = record

  Info: Integer;

  Prev: PMyType;

  Next: PMyType;

  end;

  var

  First: PMyType;

  Cursor: PMyType;

  LastNegItem: PMyType;

  i: Integer;

procedure d;{очистка памяти}

begin

while First <> nil do

  begin

  Cursor := First^.Next;

  Dispose(First);

  First := Cursor;

  end;

end;

begin

  Randomize;

  new(First); // создадим первый элемент списка

  First^.Info := Random(1000)-500;

  First^.Next := nil;

  First^.Prev := nil;

  for i := 1 to 19 do // создаем остальные 19 ;)

  begin

  new(Cursor);

  Cursor^.Info := Random(1000)-200;

  Cursor^.Next := First;

  Cursor^.Prev := nil;

  First^.Prev := Cursor;

  First := Cursor;

  end;

  WriteLn('Элементы списка: ');

  Cursor := First;

  repeat

  Write(Cursor^.Info, ' ');

  Cursor := Cursor^.Next;

  until Cursor = nil;

  WriteLn('');

  // ищем последний отрицательный элемент

  LastNegItem := nil;

  Cursor := First;

  while Cursor <> nil do

  begin

  if Cursor^.Info < 0 then

  LastNegItem := Cursor;

  Cursor := Cursor^.Next;

  end;

  if LastNegItem <> nil then

  begin // элемент существует, найдем последний элемент:

  Cursor := First;

  while Cursor^.Next <> nil do Cursor := Cursor^.Next;

  if Cursor = LastNegItem then

  begin

  WriteLn('за последним отрицательным элементов нет.');

  // создадим одно кольцо ;)

  Cursor^.Next := First;

  First^.Prev := Cursor;

  WriteLn('Единственное кольцо: ');

  First := LastNegItem^.Next;

  repeat

  Write(First^.Info, ' ');

  First := First^.Next;

  until First = LastNegItem^.Next;

  WriteLn('');

  // очистим память этого кольца

  First := LastNegItem;

  First^.Prev^.Next := nil;

  d;

  end else begin

  // Создадим сначала второе кольцо (из оставшихся элементов)

  Cursor^.Next := LastNegItem^.Next;

  LastNegItem^.Next^.Prev := Cursor;

  Cursor := Cursor^.Next;

  // теперь создадим первое кольцо

  First^.Prev := LastNegItem;

  LastNegItem^.Next := First;

  WriteLn('задача выполнена');

  WriteLn('Первое кольцо: ');

  First := LastNegItem^.Next;

  repeat

  Write(First^.Info, ' ');

  First := First^.Next;

  until First = LastNegItem^.Next;

  WriteLn('');

  WriteLn('Второе кольцо: ');

  First := Cursor;

  repeat

  Write(First^.Info, ' ');

  First := First^.Next;

  until First = Cursor;

  WriteLn('');

  // очистим память второго кольца

  First := Cursor;

  Cursor^.Prev^.Next := nil;

  d;

  // очистим память первого кольца

  First := LastNegItem;

  LastNegItem^.Prev^.Next := nil;

  d;

  end;

  end else begin

  WriteLn('Отрицательных элементов нет в списке');

  // очистим память

  d;

  end;

  end.

Программа 2дерево. pas

Type

  PTree = ^TTree;

  TTree = Record

  Data : Integer;

  Left, Right : PTree;

  end;

  var s:integer;

Procedure InsTree(var ANode : PTree; n : integer);

Begin

  if ANode = nil then

  Begin

  new(ANode);

  With ANode^ do

  Begin

  Left := nil;

  Right := nil;

  Data := n;

  end;

  end

  else if n< ANode^.Data then InsTree(ANode^.Left, n) else InsTree(ANode^.Right, n);

End;

Procedure PrintTree(ANode : PTree);{обход слева}

Begin

  if ANode <> nil then

  Begin

  PrintTree(ANode^.Left);

  Write(ANode^.Data:4);s:=s+ANode^.Data;

  PrintTree(ANode^.Right)

  End;

End;

procedure PT(ANode : PTree; n: integer);{обход справа}

  var

  i:integer;

  begin

  if  ANode<>nil then begin

  PT(ANode^.Right, n+1);

  for i := 1 to n do Write('  ');

  Writeln(ANode^.Data);

  PT(ANode^.Left, n+1);

  end;

  end;

Var

  Tree : PTree;

  n:integer;

  ch:char;

begin

  tree:=nil;

  repeat

  Writeln('BBedute 4islo, последний 0');

  readln(n);

  InsTree(tree, n);

  until n=0;

  Writeln('Derevo:');

  PrintTree(Tree);

  writeln;

  pt(Tree,0);

  writeln('Сумма элементов дерева=',s);

  readln;

end.

Программа 3поиск. pas

Type

sllptr = ^slltype;

slltype = record

  key: integer;

  left, right: sllptr;

end;

Var

e, e1,n, i,Rn, kk, x: integer;

tr: sllptr;

Procedure creating (var p:sllptr; k:integer);

Begin

If p = nil then

  begin

  New(p);

  p^.key:=k;

  p^.left:=nil;

  p^.right:=nil;

  end

else

  begin

  If k < p^.key then Creating(p^.left, k);

  If k >= p^.key then Creating(p^.right, k);

  end; 

end;

Procedure print (var p: sllptr; h:integer);

Var

i: integer;

Begin

If p <> nil then

  Begin

  Print (p^.right, h + 1);

  For i:=1 to h do

  write('  ');

  Writeln(p^.key);

  Print(p^.left, h + 1);

  end 

end;

Procedure find (var p: sllptr;x:integer);

Begin

If p <> nil then

  Begin

  find (p^.right, x);

  if p^.key=x then inc(kk);

  find(p^.left, x);

  end 

end;

Begin

Randomize;

Write('Сколько элементов в дереве<<ENTER>>: ');

ReadLn(N);

While i <= n do

  begin

  Rn := Random(25);

  Creating (tr, Rn);

  Inc(i);

  end;

print(tr,3);

Write('Введите E: ');

ReadLn(E);

find(tr, e);

WriteLn('Количество вхождений: ',  kk);

WriteLn;

WriteLn ('Для выхода нажмите любую клавишу');

ReadLn;

end.