Помощь - Поиск - Пользователи - Календарь
Полная версия: Однонаправленный список
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Boxer
Доброго времени суток!
Пишу функцию, входит ли список L1 в список L2

я пишу если 1й эл списка L1 равен i-ому эл списка L2, то запускаю массив while L1^.next<>nil do {а вот тут-то и вопрос! я хочу записать: сравниваем 2й и последующие эл списка L1 с i+1, i+2... эл списка L2, как это записать я не знаю =( }
volvo
Добавь 2 дополнительные переменные:

L2 := start_L2;
while L2 <> nil do
begin
if start_L1^.item = L2^.item then
begin
curr_L1 := start_L1^.next;
curr_L2 := L2^.next;
// Ну, а тут уже как обычно - пока один из указателей не ноль
// или элементы не равны - идешь дальше по обоим спискам одновременно
// (я имею в виду currL1 := currL1^.next и currL2 := currL2^.next)
// причем L2 у тебя не изменяется, заметь, потом можно продолжить дальше
// поиск по L2
end;

L2 := L2^.next;
end;

А вообще, задача решалась неоднократно. Поиск помучай...
Boxer
Догнал! только.. как дальше будет реализовываться поиск по L2 и если (предположим) у нас записано
L1: 2 3 4
L2:1 2 2 2 3 2 3 4 5

т.е. после третьей двойки 2 эл L1 равен 2 эл L2, а потом снова 2 3 4, т.е. нужно опть проверять 1 эл L1.... что делать тогда??
volvo
Да ничего не делать... Мой пример такие случаи на ура отрабатывает... Смотри:

  L2 := L2_start;
while L2 <> nil do
begin
if L1_start^.item = L2^.item then
begin
curr_L1 := L1_start^.next;
curr_L2 := L2^.next;

while (curr_L1 <> nil) and (curr_L1 <> nil)
and (curr_L1^.item = curr_L2^.item) do
begin
curr_L1 := curr_L1^.next;
curr_L2 := curr_L2^.next;
end;
if curr_L1 = nil then
begin
write('found: ');
// Здесь я просто печатаю весь остаток списка L2, начиная с момента
// вхождения в него L1, чтоб было понятно, правильно ли найдено вхождение
print(L2);
end
end;
L2 := L2^.next; // Дальше-то мы опять идем по L2, а этот указатель не менялся
end;

, и вот:
Running "f:\programs\pascal\2010_12_18_boxer.exe "
L1: 2 3 4
L2: 1 2 2 3 2 3 4 5
found: 2 3 4 5

Что не так? (списки "зашил" в программу, чтоб не вводить при тестировании. Лентяй я smile.gif )
Boxer
volvo, я дописал этот код, однако в некоторых местах может произойти просто взрыв мозга! Прошу помочь исправить...
uses
crt;
type
TList=^list;
List =record
item:TElem;
Next:TList;
end;

Procedure creation(Var L:TList);
Var
x :TList;
Inf:TElem;
Begin
Writeln('Введите список ');
L:= Nil;
Writeln ('Введите элементы списка. Признак конеца ввода знак " . " ');
Read (Inf);
if Inf<>0 then
Begin
New(x);
x^.next:=nil;
x^.item:=inf;
L:=x;
Read (Inf);
while Inf<>0 do
Begin
New(x^.next);
x:=x^.next;
x^.next:=nil;
x^.item:=inf;
Read(inf);
End;
End;
Writeln;
End;

procedure Print(L: TList);
begin
while l<>nil do
begin
write(l^.item);
l:=l^.next;
end;
end;

function Search(var L1,L2:list);
var
flag:boolean;
curr_L1,curr_L2,L1_start:TElem;
begin
if (L1<>nil) and (L2<>nil) then
begin
L1 := L1_start;
while L2 <> nil do
begin
if L1_start^.item = L2^.item then
begin
curr_L1 := L1_start^.next;
curr_L2 := L2^.next;
flag:=true;
while (curr_L1 <> nil) and (curr_L1 <> nil)and flag do
begin
if curr_L1^.item<>curr_L2^.item then flag:=false;
curr_L1 := curr_L1^.next;
curr_L2 := curr_L2^.next;
end;
if curr_L1 = nil then
begin
write('found: ');
print(L2);
end;
end;
L2 := L2^.next;
end;
end;
end;

begin
clrscr;
write('Please enter list L1: ');readln(L1);
write('Please enter list L2: '):readln(L2);
creation(L1);
creation(L2);
Search(L1,L2);
end.
volvo
Цитата
может произойти просто взрыв мозга!
Ничего тут произойти не может, твой код даже компилироваться не будет...

Цитата
я дописал этот код
Во-первых, ты не дописал, а переписал код (это два совершенно разных слова, заметь). Зачем понадобилось в тот код, что я показал, вносить изменения, причем совершенно ненужные? Я ж сказал, что приведенный фрагмент работает. Надо было только оформить его функцией, и правильно написать получение списка от пользователя. Вот, смотри:
type
telem = integer;

TList=^list;
List =
record
item:TElem;
Next:TList;
end;

Procedure creation(Var L:TList);
Var
x, last :TList;
Inf: TElem;
Begin
L := Nil; last := nil;
Writeln ('Введите элементы списка.');
while not eoln do
begin
read(inf);
new(x);
x^.next:=nil;
x^.item:=inf;
if L = nil then L := x
else last^.next := x;
Last := x;
end;
readln;
Writeln;
End;

procedure Print(L: TList);
begin
while l<>nil do
begin
write(l^.item:3);
l:=l^.next;
end;
writeln;
end;

function Search(L1_start, L2_start: tlist): boolean;
var
L2, curr_L1,curr_L2:TList;
begin
search := False;
if (L1_start<>nil) and (L2_start<>nil) then
begin
L2 := L2_start;
while L2 <> nil do
begin
if L1_start^.item = L2^.item then
begin
curr_L1 := L1_start^.next;
curr_L2 := L2^.next;
while (curr_L1 <> nil) and (curr_L1 <> nil) and (curr_L1^.item = curr_L2^.item) do
begin
curr_L1 := curr_L1^.next;
curr_L2 := curr_L2^.next;
end;
if curr_L1 = nil then
begin
Search := true;
write('found: ');
print(L2);
end;
end;
L2 := L2^.next;
end;
end;
end;

var L1, L2: tlist;
begin
L1 := nil; L2 := nil;
write('Please enter list L1: '); creation(L1);
write('Please enter list L2: '); creation(L2);
write('L1: '); print(L1);
write('L2: '); print(L2);
if not Search(L1, L2) then
begin
writeln('not found');
end;
readln;
end.


Please enter list L1: Введите элементы списка.
2 3 4

Please enter list L2: Введите элементы списка.
1 2 2 3 2 3 4 5

L1: 2 3 4

L2: 1 2 2 3 2 3 4 5

found: 2 3 4 5

Не надо никаких точек как признака окончания ввода, есть функция Eoln, которая понимает, когда закончилась строка.

Во вторых, в следующий раз пытайся хотя бы откомпилировать программу, и исправить те ошибки на которые указывает компилятор. О неописанном типе, о несуществующих переменных, например.

Ну, и в третьих: программа еще не закончена. Добавляй код удаления списков... Без него ни один уважающий себя преподаватель программу не примет. Работодатель - тем более...
Boxer
Хорошо, буду работать.
спасибо за помощь, допишу
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.