Полная версия: R-список
Нужно написать процедуру в R-списе(info:string) (кольцевой список), которая меняет местами слова с четными номерами и нечетными (1-е со 2-м и т.д.)
Твою реализацию кольцевого списка - в студию !!! 
Код
uses crt;
type ptr=^node;
node=record
info:string;
link:ptr;
end;
var front,fin:ptr;
procedure inqueue(c:string);
var p:ptr;
begin
new(p);
p^.info:=c;
p^.link:=nil;
if fin<>nil then
begin
fin^.link:=p;
end
else
front:=p;
fin:=p;
end;
function outqueue:string;
var p:ptr;
begin
if front<>nil then
begin
outqueue:=front^.info;
p:=front^.link;
dispose(front);
front:=p;
if front=nil then
fin:=nil;
end
else
begin
TextColor(red);
writeln(' Ошибка! Список пуст');
outqueue:=' ';
TextColor(7);
writeln(' Для продолжения работы нажмите Enter '); end
end;
procedure show;
var p,q:ptr;
var inf:string;
begin
q:=front;
repeat
p:=q^.link;
inf:=q^.info;
write(inf,'; ');
q:=p;
until(q=nil);
end;
procedure out;
var p:ptr;
begin
if front<>nil then
repeat
p:=front^.link;
dispose(front);
front:=p;
until(front=nil);
end;
procedure pe(p:ptr); Вот сама процедура
var
r:ptr;
begin
if front<>nil then
begin
new(r);
r^.info:=p^.info;
r^.link:=p^.link;
p^.link:=r;
pe(r^.link);
end;
end;
----конец----
var n,i:integer;
var k,z:string;
begin
front:=nil;
fin:=nil;
repeat
clrscr;
writeln('Выберете деиствие');
writeln('1-Ввести элемент');
writeln('2-Убрать элемент');
writeln('3-Посмотреть все');
writeln('4-Перестановка');
writeln('5-Выход');
writeln;
write(' Введите команду и нажмите ВВОД: ');
readln(n);
if n=1 then
begin
writeln(' Введите символ');
write(' ');
readln(k);
inqueue(k);
end
else
if n=2 then
begin
write(outqueue);
readln;
end
else
if n=3 then
begin
write(' Список: ');
show;
readln;
end
else
if n=4 then
begin
pe(front);
end
until(n=5);
out;
end.
Вот так:
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while (p <> nil) and (p^.link <> nil) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
Спасибо. Все работает. Но правда это у меня не кольцевой список.
Вот правильная реализация с твоей процедурой
uses CRT;
type ptr=^node;
node=record
info:string;
link:ptr;
end;
var top,w2:ptr;
a:word;
b:string;
procedure Push(n:string);
var w1,w2:ptr;
begin
new(w1);
w1^.info:=n;
w2^.link:=w1^.link;
w1^.link:=top;
top:=w1;
end;
procedure vid(w1:ptr);
begin
if (w1<>w2) then
begin;
vid(w1^.link);
write(w1^.info,' ')
end;
end;
{__________инверсия списка__________}
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while (p <> nil) and (p^.link <> nil) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
{__________удаления списка__________}
function Pop:string;
var
l:ptr;
begin
if top <> l then
begin
l:=top^.link;
Pop:=top^.info;
dispose (top);
top:=l;
end
else begin
Writeln(' Ошибка! Список пуст ');
pop:=' ';
end;
end;
{__________конец удаления__________}
begin
repeat
clrscr;
writeln(' 1-Ввод числа в список');
writeln(' 2-Удаление числа из списка');
writeln(' 3-Вывод списка на экран');
writeln(' 4-Вывод инвертированного списка');
writeln(' 5-Выход из программы');
write(' Введите команду ');
readln(a);
if a=1 then
begin
write(' Введите слово: ');
readln(b);
Push(b);
end else
if a=2 then
begin
Writeln;
Write(Pop);
writeln(' удалено из стека');
readln;
end else
if a=3 then
begin
Write(' Список:');
vid(top);
Writeln;
readln;
end else
if a=4 then
begin
Write(' Исходный список:');
vid(top);
Writeln;
Write(' Инвертированный список:');
pe(top);
Writeln;
readln;
end else
if a>5 then
Begin
Writeln(' Неправильный ввод! ');
end;
until(a=5)
end.
Но теперь, если в лоб ставить твою процедуру, то перевернутый список не выводиться на экран.
Помоги разобраться, в чем беда.
Вот правильная реализация с твоей процедурой
Код
uses CRT;
type ptr=^node;
node=record
info:string;
link:ptr;
end;
var top,w2:ptr;
a:word;
b:string;
procedure Push(n:string);
var w1,w2:ptr;
begin
new(w1);
w1^.info:=n;
w2^.link:=w1^.link;
w1^.link:=top;
top:=w1;
end;
procedure vid(w1:ptr);
begin
if (w1<>w2) then
begin;
vid(w1^.link);
write(w1^.info,' ')
end;
end;
{__________инверсия списка__________}
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while (p <> nil) and (p^.link <> nil) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
{__________удаления списка__________}
function Pop:string;
var
l:ptr;
begin
if top <> l then
begin
l:=top^.link;
Pop:=top^.info;
dispose (top);
top:=l;
end
else begin
Writeln(' Ошибка! Список пуст ');
pop:=' ';
end;
end;
{__________конец удаления__________}
begin
repeat
clrscr;
writeln(' 1-Ввод числа в список');
writeln(' 2-Удаление числа из списка');
writeln(' 3-Вывод списка на экран');
writeln(' 4-Вывод инвертированного списка');
writeln(' 5-Выход из программы');
write(' Введите команду ');
readln(a);
if a=1 then
begin
write(' Введите слово: ');
readln(b);
Push(b);
end else
if a=2 then
begin
Writeln;
Write(Pop);
writeln(' удалено из стека');
readln;
end else
if a=3 then
begin
Write(' Список:');
vid(top);
Writeln;
readln;
end else
if a=4 then
begin
Write(' Исходный список:');
vid(top);
Writeln;
Write(' Инвертированный список:');
pe(top);
Writeln;
readln;
end else
if a>5 then
Begin
Writeln(' Неправильный ввод! ');
end;
until(a=5)
end.
Но теперь, если в лоб ставить твою процедуру, то перевернутый список не выводиться на экран.
Помоги разобраться, в чем беда.
Ну, так ты же его не выводишь...
Write(' Исходный список:');
vid(top);
Writeln;
Write(' Инвертированный список:');
pe(top);
vid(top); { <-- Добавь вот это... }
Writeln;
Да я слепой...
Теперь у меня возник другой вопрос:
если вводишь чётное количество элементов всё работает нормально,
а если нечётное ,то первый элемент остается на месте ,а все остольные меняються.
Может нужно через счётчик?
Теперь у меня возник другой вопрос:
если вводишь чётное количество элементов всё работает нормально,
а если нечётное ,то первый элемент остается на месте ,а все остольные меняються.
Может нужно через счётчик?
В кольцевом списке недолжно быть указателя nil на поля ввода.А должен быть указатель на хвост(q).
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while (p^.link <> q) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
Вот так попробовал но при выводе на экран вылетает.
Помоги.
Код
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while (p^.link <> q) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
Вот так попробовал но при выводе на экран вылетает.
Помоги.
Ты меня конечно извини, но твоя программа у меня вообще не работает (даже не добавляет элементы)... И ошибки очень грубые:
1)
Чему по-твоему равно W2 там где я показал, и какое право ты имеешь обращаться к полю неинициализированного указателя?
2)
Что ты делаешь в выделенной строке? Турбо Паскаль не позволяет производить с указателями никаких действий, кроме сравнения с nil... Сравнения адресов между собой - это в 32-битных компиляторах (а так как для них есть специальный раздел, а ты создал тему здесь - то твоя программа неправильна, и в TP работать если и будет - то некорректно)...
Исправляй.
1)
procedure Push(n:string);
var w1,w2:ptr;
begin
new(w1);
w1^.info:=n;
w2^.link:=w1^.link; { <-- Вот это что значит??? }
w1^.link:=top;
top:=w1;
end;
Чему по-твоему равно W2 там где я показал, и какое право ты имеешь обращаться к полю неинициализированного указателя?
2)
procedure vid(w1:ptr);
begin
if (w1<>w2) then { <--- Здесь !!! }
begin;
vid(w1^.link);
write(w1^.info,' ')
end;
end;
Что ты делаешь в выделенной строке? Турбо Паскаль не позволяет производить с указателями никаких действий, кроме сравнения с nil... Сравнения адресов между собой - это в 32-битных компиляторах (а так как для них есть специальный раздел, а ты создал тему здесь - то твоя программа неправильна, и в TP работать если и будет - то некорректно)...
Исправляй.
Код
procedure pe(p:ptr);
var
q:ptr;
T: string;
begin
q := p;
while
{(p <> nil ) недолжно быть :(}
(p = q) and (p^.link <> q) do begin
T := p^.info;
p^.info := p^.link^.info;
p^.link^.info := T;
p := p^.link^.link;
end;
end;
Тогда меняются местами только последнии два эл-та.
Насчет 1) так по лекциии создается кольцевой список
2) мы сравниваем и после этого выводим на экран
Насчёт 32 битных компеляторов незнаю, мы работаем в обычном Borland Pascal 7.0
Вот так
Цитата
Насчет 1) так по лекциии создается кольцевой список
Выброси эту лекцию... Кольцевой список создается точно так же, как обычный (first - начало, last - конец), просто последним действием идет:last^.next := first; { Теперь это уже "кольцо" }
, а работать с неинициализированными переменными тебя никакой нормальный лектор учить не будет...
Вот тебе принцип работы с R-списком (меню добавишь сам):
type
ttype = string;
plist = ^tlist;
tlist = record
info: ttype;
next: plist;
end;
var
first, last: plist;
{ Печать кольцевого списка (без рекурсии) }
procedure print(p: plist);
begin
repeat
write(p^.info, '':2);
p := p^.next;
until p = first;
writeln;
end;
{ Добавление элемента в конец списка }
procedure append(x: ttype);
var p: plist;
begin
new(p);
p^.info := x;
p^.next := nil;
if first = nil then first := p
else last^.next := p;
last := p
end;
{ Та процедура, которая тебе нужна }
procedure change(p: plist);
var
q: plist;
is_first: boolean;
T: ttype;
begin
is_first := true;
repeat
if (is_first or (p <> first)) and (p^.next <> first) then begin
T := p^.info;
p^.info := p^.next^.info;
p^.next^.info := T;
p := p^.next^.next;
end;
until (p = first) or (p^.next = first);
end;
var
X: ttype;
begin
first := nil; last := nil;
repeat
write('next element (empty string to exit): '); readln(X);
if X <> '' then append(X);
until X = '';
last^.next := first; { "Зацикливаем" список }
write('list: '); print(first);
change(first);
write('list after: '); print(first);
end.
С НОВЫМ ГОДОМ!!!
Спасибо за твою реализацию списка.
Если мы создаём два указателя(prev, link) то это Д-список, правельно?
type
PList = ^TList;
TList = record
info: string;
prev, link: PList;
end;
Спасибо за твою реализацию списка.
Если мы создаём два указателя(prev, link) то это Д-список, правельно?
Код
type
PList = ^TList;
TList = record
info: string;
prev, link: PList;
end;
Да... Твоя же задача для D-списка тоже решена на форуме (пользуйся поиском, я точно ее выкладывал...)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.