Решаем задачи Абрамян на Паскале. Pointer49

Pointer49. Дан указатель $$P_1$$ на первый элемент непустого двусвязного списка. Перегруппировать его элементы, переместив все элементы с нечетными номерами в конец списка (в том же порядке) и вывести указатель на первый элемент преобразованного списка. Операции выделения и освобождения памяти не использовать, поля Data не изменять.

Решение:

program Pointer49;
type
  PNode=^TNode;
  TNode=record
    Data: Integer;
    Next: PNode;
    Prev: PNode;
  end;

procedure CreateList(var P1,P2:PNode);
var
 pt1,pt2:PNode;
 i,N:integer;
begin
 Write('NumEl:');
 Readln(N);
 new(p1);
 Write('num: ');
 Readln(P1^.Data);
 pt2:=p1;

 for i:=1 to N-1 do
  begin
   new(pt1);
   Write('num: ');
   Readln(pt1^.Data);
   pt1.Prev:=pt2;
   pt2.Next:=pt1;
   pt2:=pt2.Next;
  end;
 pt2.Next:=nil;
 p2:=pt2;
end;


Function GetEndPoint(P0:PNode):PNode;
begin
 Result:=P0;
 while (Result.Next<>nil) do
  Result:=Result.Next;
end;

procedure MoveEnd(var P1,P2:PNode;P0:PNode);
begin
 if P0<>P2 then
  begin
   P0.Next.Prev:=P0.Prev;
   if P0.Prev<>nil then P0.Prev.Next:=P0.Next
   else P1:=P0.Next;


   P0.Next:=nil;
   P0.Prev:=P2;

   P2.Next:=P0;
   P2:=P0;
  end;
end;


procedure MoveOddEnd2(var P1,P2:PNode);
var
 p,q,pend:PNode;
 len:integer;
begin
 len:=0;
 p:=P1;
 pend:=P2;
 while (p<>pend) do
  begin
   inc(len);
   q:=p;
   p:=p.Next;
   if odd(len) then MoveEnd(P1,P2,q);
  end;
 inc(len);
 if odd(len) then MoveEnd(P1,P2,pend);
end;

var
 P1,P2:PNode;
 a:^Word;
begin
 CreateList(P1,P2);
 P2:=nil;

 P2:=GetEndPoint(P1);

 MoveOddEnd2(P1,P2);

 a:=Addr(P1);
 Writeln('begin: ',a^);
end.

program Pointer49;

type

PNode=^TNode;

TNode=record

Data: Integer;

Next: PNode;

Prev: PNode;

end;

procedure CreateList(var P1,P2:PNode);

var

pt1,pt2:PNode;

i,N:integer;

begin

Write('NumEl:');

Readln(N);

new(p1);

Write('num: ');

Readln(P1^.Data);

pt2:=p1;

for i:=1 to N-1 do

begin

new(pt1);

Write('num: ');

Readln(pt1^.Data);

pt1.Prev:=pt2;

pt2.Next:=pt1;

pt2:=pt2.Next;

end;

pt2.Next:=nil;

p2:=pt2;

end;

Function GetEndPoint(P0:PNode):PNode;

begin

Result:=P0;

while (Result.Next<>nil) do

Result:=Result.Next;

end;

procedure MoveEnd(var P1,P2:PNode;P0:PNode);

begin

if P0<>P2 then

begin

P0.Next.Prev:=P0.Prev;

if P0.Prev<>nil then P0.Prev.Next:=P0.Next

else P1:=P0.Next;

P0.Next:=nil;

P0.Prev:=P2;

P2.Next:=P0;

P2:=P0;

end;

procedure MoveOddEnd2(var P1,P2:PNode);

var

p,q,pend:PNode;

len:integer;

begin

len:=0;

p:=P1;

pend:=P2;

while (p<>pend) do

begin

inc(len);

q:=p;

p:=p.Next;

if odd(len) then MoveEnd(P1,P2,q);

end;

inc(len);

if odd(len) then MoveEnd(P1,P2,pend);

end;

var

P1,P2:PNode;

a:^Word;

begin

CreateList(P1,P2);

P2:=nil;

P2:=GetEndPoint(P1);

MoveOddEnd2(P1,P2);

a:=Addr(P1);

Writeln('begin: ',a^);

end.

Другие задачи из раздела Pointer можно посмотреть здесь.

Решаем задачи Абрамян на Паскале. Pointer49

Комментарии:

Добавить комментарий Отменить ответ