Односвязные списки - Pascal

Узнай цену своей работы

Формулировка задачи:

не могу понять в чём ошибка. ВОт полностью программа
program laba16;
 
{$APPTYPE CONSOLE}
{Ââåñòè ïîñëåäîâГ*òåëüГ*îñòü Г*Г*ГІГіГ°Г*ëüГ*ûõ Г·ГЁГ±ГҐГ«. Åñëè Гў ïîñëåäîâГ*òåëüГ*îñòè ГҐГ±ГІГј õîòÿ ГЎГ» îäГ*Г® ÷èñëî,
ñîäåðæГ*Г№ГҐГҐ äâå îäèГ*Г*êîâûõ öèôðû, óïîðÿäî÷èòü ïîñëåäîâГ*òåëüГ*îñòü ГЇГ® Г*åóáûâГ*Г*ГЁГѕ ïåðâîé öèôðû Г·ГЁГ±Г«Г*.
Г‚ ïðîòèâГ*îì ñëó÷Г*ГҐ ГіГ¤Г*ëèòü ГЁГ§ ïîñëåäîâГ*òåëüГ*îñòè Г·ГҐГІГ*ûå Г·ГЁГ±Г«Г* ГЁ ïðîäóáëèðîâГ*ГІГј Г*ГҐГ·ГҐГІГ*ûå Г·ГЁГ±Г«Г*.
 ÏîñëåäîâГ*òåëüГ*îñòü õðГ*Г*ГЁГІГј Гў îäГ*îñâÿçГ*îì Г±ГЇГЁГ±ГЄГҐ. Ïåðåä Г§Г*âåðøåГ*ГЁГҐГ¬ ïðîãðГ*ììû
  î÷èñòèòü äèГ*Г*ìè÷åñêóþ ГЇГ*ìÿòü Г± ïîìîùüþ ïðîöåäóðû Dispose.}
 
uses
  SysUtils;
 
function perv(a:Integer):Integer;
  begin
    while (a>10)   do
    begin
      a:=a div 10;
    end;
    perv:=a;
    end;
 
    function odin(a:Integer):Boolean;
    var x,y:integer;
  begin
    odin:=false;
    while a>0 do
    begin
     x:=a mod 10;
     y:=a div 10;
     while y>0 do
     begin
       if (x=y mod 10) then odin:=true;
       y:=y div 10;
     end;
     a:=a div 10;
  end;
  end;
 
   Type
    P_Stack =   ^T_Stack;
    T_Stack =   Record
                Num : integer;
                Next : p_stack;
            End;
Var
    Top,p,p1,p2,x   : P_Stack;
    Num,r,min: integer;
Begin
 
  r:=0;
  {Ââîäèì ïîñëåäîâГ*òåëüГ*îñòü}
    Top:=Nil;
    While Not SeekEoLn Do Begin
        Read(Num);
        New(p);
        p^.Num:=Num;
        p^.Next:=Top;
        Top:=p;
    End;
 {ÏðîâåðêГ*, ГҐГ±ГІГј ëè ГЎГіГЄГўГ» Г± îäèГ*ГЄГ*îâûìè öèôðГ*ìè}
  p:=Top;
    While p<>Nil Do
  begin
    if odin(p^.Num) then inc(r);
    p:=p^.Next;
  end;
  {Åñëè åñòü}
  if r>0 then
  begin
 
    {Óïîðÿäî÷èâГ*Г*ГЁГҐ ГЇГ® Г*åóáûâГ*Г*ГЁГѕ}
    p1:=Top;
     While p1^.Next<>Nil Do Begin
        p2:=p1^.Next;
        While p2<>Nil Do Begin
            If perv(p1^.Num)>perv(p2^.Num) Then Begin
                Num:=p1^.Num;
                p1^.Num:=p2^.Num;
                p2^.Num:=Num;
            End;
            p2:=p2^.Next;
        End;
        p1:=p1^.Next;
     End;
   end
   {Åñëè Г*ГҐГІ}
  else
   begin
      {ÓÄГ*ëÿåì Г·ГҐГІГ*ûå Г·ГЁГ±Г«Г*}
      p1:=Top;
      while p1<>nil do
      begin
        p:=Top;
        While p<>Nil Do
        begin
          If (p^.Num mod 2=0) Then begin  x:=p; break; end;
          P:=p^.Next;
        end;
 
        If x<>Top Then
        Begin
          p:=Top;
          While p^.Next<>x Do P:=p^.Next;
        End;
         p:=top;
 
        If x=Top    Then Top:=Top^.Next
        Else p^.Next:=x^.Next;
        Dispose(x);
        p1:=p1^.Next;
       end;
        {Äóáëèðóåì Г*ГҐГ·ГҐГІГ*ûå}
      p1:=Top;
     while p1<>nil do
      begin
        p:=Top;
        While p<>Nil Do    begin
        If p^.Num mod 2<>0 Then begin  x:=p; break;  end; P:=p^.Next; end;
 
          New(p);
          p^.Num:=x^.num;
          p^.Next:=x^.Next;
          x^.Next:=p;
        Dispose(x);
        p1:=p1^.Next;
      end;

   end;
 
      {Âûâîä Г*Г* ГЅГЄГ°Г*Г*}
    p:=top;
    While p<>Nil Do
    begin
        WriteLn(p^.Num);
        p:=p^.Next;
    end;
 
    {ÓäГ*ëåГ*ГЁГҐ}
    While Top<>Nil Do Begin
        p:=Top^.Next;
        Dispose(Top);
        Top:=p;
      End;

  readln;
  Readln;
 
 end.
Фрагмент, в котором ошибка:
begin
      {ÓÄГ*ëÿåì Г·ГҐГІГ*ûå Г·ГЁГ±Г«Г*}
      p1:=Top;
      while p1<>nil do
      begin
        p:=Top;
        While p<>Nil Do
        begin
          If (p^.Num mod 2=0) Then begin  x:=p; break; end;
          P:=p^.Next;
        end;
 
        If x<>Top Then
        Begin
          p:=Top;
          While p^.Next<>x Do P:=p^.Next;
        End;
         p:=top;
 
        If x=Top    Then Top:=Top^.Next
        Else p^.Next:=x^.Next;
        Dispose(x);
        p1:=p1^.Next;
       end;
        {Äóáëèðóåì Г*ГҐГ·ГҐГІГ*ûå}
      p1:=Top;
     while p1<>nil do
      begin
        p:=Top;
        While p<>Nil Do    begin
        If p^.Num mod 2<>0 Then begin  x:=p; break;  end; P:=p^.Next; end;
 
          New(p);
          p^.Num:=x^.num;
          p^.Next:=x^.Next;
          x^.Next:=p;
        Dispose(x);
        p1:=p1^.Next;
      end;

   end;

Решение задачи: «Односвязные списки»

textual
Листинг программы
program laba16;
 
{$APPTYPE CONSOLE}
{Ввести последовательность натуральных чисел. Если в последовательности есть хотя бы одно число,
содержащее две одинаковых цифры, упорядочить последовательность по неубыванию первой цифры числа.
В противном случае удалить из последовательности четные числа и продублировать нечетные числа.
 Последовательность хранить в односвязном списке. Перед завершением программы
  очистить динамическую память с помощью процедуры Dispose.}
 
uses
   SysUtils;
 
function perv(a:Integer):Integer;
begin
   while (a>10) do a:=a div 10;
   perv:=a;
end;
 
function odin(a:Integer):Boolean;
var x,y:integer;
begin
   odin:=false;
   while a>0 do
   begin
      x:=a mod 10;
      y:=a div 10;
      while y>0 do
      begin
         if (x=y mod 10) then odin:=true;
         y:=y div 10;
      end;
      a:=a div 10;
   end;
end;
 
Type
   P_Stack = ^T_Stack;
   T_Stack = 
   Record
      Num : integer;
      Next : p_stack;
   End;
   
Var
   Top, bottom,p,p1,p2,x   : P_Stack;
   Num,r,min: integer;
Begin
   r:=0;
   {Вводим последовательность, тольковводим ее правильно,
    добавляя новый элемент в конец списка, а не прилепляя к началу...}
   Top:=Nil; bottom := nil;
   While Not SeekEoLn Do 
   Begin
      Read(Num);
      New(p);
      p^.num := num;
      p^.next := nil;
 
      if top = nil then top := p
      else bottom^.next := p;
      bottom := p;
   End;
   
   {Проверка, есть ли буквы с одинкаовыми цифрами}
   p:=Top;
   While p<>Nil Do
   begin
      if odin(p^.Num) then inc(r);
      p:=p^.Next;
   end;
   
   {Если есть}
   if r>0 then
   begin
      {Упорядочивание по неубыванию - эту часть не проверял}
      p1:=Top;
      While p1^.Next<>Nil Do 
      Begin
         p2:=p1^.Next;
         While p2<>Nil Do 
         Begin
            If perv(p1^.Num)>perv(p2^.Num) Then 
            Begin
               Num:=p1^.Num;
               p1^.Num:=p2^.Num;
               p2^.Num:=Num;
            End;
            p2:=p2^.Next;
         End;
         p1:=p1^.Next;
      End;
   end
   {Если нет}
   else
   begin
      p := top; 
      { Вот эту - переделал, как положено. Итак: 
        идем по списку "с отставанием", то есть, работаем
        всегда с тем элементом, который после указателя,
        чтобы, при необходимости, поправить ссылку }
      while p^.next <> nil do
      begin
         {Удаляем четные числа}
         while (p^.next <> nil) and not odd(p^.next^.num) do
         begin
            x := p^.next;
            p^.next := x^.next;
            dispose(x);
         end;
         {Дублируем нечетные}
         while (p^.next <> nil) and odd(p^.next^.num) do
         begin
            new(x);
            x^.next := p^.next;
            x^.num := p^.next^.num;
            p^.next := x;
            p := p^.next^.next; { вот тут - внимательно: продвигаемся еще раз }
         end;       
      end;
      { а вот теперь работаем с первым элементом списка: }
      if odd(top^.num) then { если он нечетный - дублируем }
      begin
         new(x);
         x^.next := top;
         x^.num := top^.num;
         top := x;
      end
      else { четный - удаляем }
      begin
         x := top;
         top := top^.next;
         dispose(x);
      end;
   end;
   
   {Вывод на экран}
   p:=top;
   While p<>Nil Do
   begin
      Write(p^.Num:4);
      p:=p^.Next;
   end;
 
   {Удаление}
   While Top<>Nil Do 
   Begin
      p:=Top^.Next;
      Dispose(Top);
      Top:=p;
   End;
   Readln;
end.

Оцени полезность:

7   голосов , оценка 4.286 из 5
Похожие ответы