type point = ^item; item = record number : integer; next : point; end; procedure InitList(var first: point); var last: point; procedure AddItem(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); AddItem(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 FindList(where, what: point; var prev: point): point; function EqualLists(first, second: point): boolean; var match: boolean; begin match := true; while (second <> nil) and match do begin match := (first^.number = second^.number) and not((first^.next = nil) and (second^.next <> nil)); if match then begin first := first^.next; second := second^.next; end; end; EqualLists := match end; var found: boolean; begin FindList := nil; found := false; prev := nil; while (where <> nil) and (not found) do begin found := EqualLists(where, what); if not found then begin prev := where; where := where^.next; end; end; if found then FindList := where; end; procedure Replace(Prev: point; Var L: point; start, L2, L1: point); var p: point; begin p := start; if prev = nil then L := L2 else prev^.next := L2; while L1^.next <> nil do begin L1 := L1^.next; p := p^.next; end; while L2^.next <> nil do L2 := L2^.next; L2^.next := p^.next; p^.next := nil; { <--- } end; procedure Destroy(var L: point); var T: point; begin while L <> nil do begin T := L; L := L^.next; dispose(T); end; end; var L, L1, L2, subList, before: point; begin writeln('L1 : '); InitList(L1); PrintList(L1); writeln('L2 : '); InitList(L2); PrintList(L2); writeln('L : '); InitList(L); PrintList(L); subList := FindList(L, L1, before); if subList = nil then writeln('No') else begin Replace(before, L, subList, L2, L1); PrintList(L); end; Destroy(L); Destroy(L1); Destroy(subList); readln; end.