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.
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.
.И персональное СПАСИБО volvo и klem4
