Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Задачи на списки
Автор: Nastas'ka 20.10.2005 20:48
Уже месяц не могу решить задачу. а сдать надо было давно, может кто-нидь поможет 
Текст задачи: В списке L заменить первое вхождение списка L1 на список L2. Решить задачу на однонаправленный список, на двунаправленный и кольцевой.Простым методом и рекурсивным. Помогите хотя бы простым методом на однонаправленный список, дальше может сама разберусь ;)
Автор: volvo 20.10.2005 20:58
Nastas'ka, сам список реализован? Или с этим тоже есть проблема?
Если нет реализации самого списка, то идешь сюда:
http://forum.pascal.net.ru/index.php?showtopic=2706&view=findpost&p=23570
или сюда:
http://forum.pascal.net.ru/index.php?showtopic=2706&view=findpost&p=40860
Автор: klem4 20.10.2005 23:56
Вот решение, но может быть ошибка, так как сам делал задачу на списки первый раз в жизни ;) Так что кто увидит баг, кричите :yes:
Только я обозначения перепутал, в моей программа ищется первое вхождение L2 в L1 и заменяется на L
uses crt;
type
point = ^item;
item = record
number : integer;
next : point;
end;
var
L, L1, L2, temp : point;
procedure InitItem(var P : point);
var
first : point;
n,num : integer;
begin
write('n='); readln(n);
first := nil;
while(n>0) do begin
new(P);
P^.next := first;
write('Item[',n,']=');
readln(num);
P^.number := num;
first := P;
dec(n);
end;
end;
procedure PrintItem(P : point);
begin
while(p<>nil) do begin
writeln(p^.number);
p := p^.next;
end;
end;
function FindFirstP(a, b : point) : point;
var
res, aBack, bBack : point;
begin
res := nil;
aBack := a;
bBack := b;
while (a<>nil) and (b<>nil) and (res=nil) do begin
res := nil;
while (a<>nil) and (a^.number<>b^.number) do
a := a^.next;
aBack := a;
if (a<>nil) then begin
res := a;
while (a<>nil) and (b<>nil) and (a^.number=b^.number) do begin
a := a^.next;
b := b^.next;
end;
if (b<>nil) then begin
res := nil;
b := bBack;
a := aBack;
a := a^.next;
end
end;
end;
FindFirstP := res;
end;
procedure ReformItem(a, b, p : point);
begin
a := p;
while (a<>nil) and (b<> nil) do begin
a^.number := b^.number;
a := a^.next;
b := b^.next;
end;
end;
Begin
clrscr;
writeln('L1 : ');
InitItem(L1);
writeln;
writeln('L2 : ');
InitItem(L2);
writeln('L3 : ');
InitItem(L);
writeln;
temp := FindFirstP(L1, L2);
if temp = nil then
writeln('No')
else begin
writeln;
ReformItem(L1, L, temp);
PrintItem(L1);
end;
readln;
End.
Автор: volvo 21.10.2005 2:56
А у меня вот что получилось:
uses crt;
type
point = ^item;
item = record
number : integer;
next : point;
end;
var
L, L1, L2, temp : point;
procedure InitList(var first: point);
var
last: point;
procedure add_item(item: integer);
var p: point;
begin
new(p);
p^.number := item; p^.next := nil;
if first = nil then first := p
else last^.next := p;
last := p
end;
var
n, X: integer;
begin
write('n = '); readln(n);
first := nil; last := nil;
while n > 0 do begin
write('next item = '); readln(X);
add_item(X); dec(n);
end;
end;
procedure PrintList(L: point);
begin
write('list: < ');
while L <> nil do begin
write(L^.number, ' ');
L := L^.next
end;
WriteLn('>');
WriteLn;
end;
function CheckEquals(L, second: point): boolean;
var match: boolean;
begin
match := True;
while (second <> nil) and match do begin
match := (L^.number = second^.number) and
not((L^.next = nil) and (second^.next <> nil));
if match then begin
L := L^.next; second := second^.next;
end;
end;
CheckEquals := match
end;
var
before: point;
function FindFirstPtr(L, sub: point): point;
var found: boolean;
begin
FindFirstPtr := nil;
found := false; before := nil;
while (L <> nil) and not (found) do begin
found := CheckEquals(L, sub);
if not found then begin
before := L; L := L^.next;
end;
end;
if found Then FindFirstPtr := L
end;
procedure ChangeLists(Prev: point;
Var FromL, ToL: point; OldOne: point);
var p: point;
begin
p := FromL;
Prev^.next := ToL;
while OldOne^.next <> nil do begin
OldOne := OldOne^.next;
p := p^.next;
end;
while ToL^.next <> nil do
ToL := ToL^.next;
ToL^.next := p^.next;
end;
procedure ReformItem(a, b, p : point);
begin
a := p;
while (a<>nil) and (b<> nil) do begin
a^.number := b^.number;
a := a^.next;
b := b^.next;
end;
end;
Begin
clrscr;
writeln('L1 : ');
InitList(L1); PrintList(L1);
writeln('L2 : ');
InitList(L2); PrintList(L2);
writeln('L : ');
InitList(L); PrintList(L);
temp := FindFirstPtr(L, L1);
if temp = nil then writeln('No')
else begin
ChangeLists(before, temp, L2, L1);
PrintList(L);
end;
readln;
End.
Автор: Nastas'ka 21.10.2005 20:29
Спасибо большое-большое, вы мне очень помогли 
.И персональное СПАСИБО volvo и klem4
Автор: yuivanenko 12.05.2010 21:29
Проверяю программу для данных L1- {2;3} L2={0;0;0} L={2;3;2;3} выбивает прогграмму без всяких ответов. Подскажите почему?
Автор: volvo 12.05.2010 21:55
Программа отлаживалась для случая, когда L1 содержится в списке L не с самого начала:
L1- {2;3} L2={0;0;0} L={1;2;3;2;3} - прекрасно отрабатывает... Для указанного случая придется чуть-чуть подкорректировать программу. Хотя сейчас я бы переделал программу совершенно по-другому.
Например, вот так: 
sub_list.pas ( 2.45 килобайт )
Кол-во скачиваний: 519
P.S. Кстати, память в программе из 4-го поста не освобождается...
Автор: yuivanenko 14.05.2010 0:44
Программа отлаживалась для случая, когда L1 содержится в списке L не с самого начала:
L1- {2;3} L2={0;0;0} L={1;2;3;2;3} - прекрасно отрабатывает... Для указанного случая придется чуть-чуть подкорректировать программу. Хотя сейчас я бы переделал программу совершенно по-другому.
Например, вот так:
sub_list.pas ( 2.45 килобайт )
Кол-во скачиваний: 519P.S. Кстати, память в программе из 4-го поста не освобождается...
Огромное спасибо. Сейчас работает со всеми данными