Односвязные списки - 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.