Задачи на списки Опции

[Nastas'ka]

Уже месяц не могу решить задачу. а сдать надо было давно, может кто-нидь поможет
Текст задачи: В списке L заменить первое вхождение списка L1 на список L2. Решить задачу на однонаправленный список, на двунаправленный и кольцевой.Простым методом и рекурсивным. Помогите хотя бы простым методом на однонаправленный список, дальше может сама разберусь ;)

[volvo]

Nastas'ka, сам список реализован? Или с этим тоже есть проблема?
Если нет реализации самого списка, то идешь сюда:
FAQ: Списки

или сюда:
FAQ: Динамические структуры данных

[klem4]

Вот решение, но может быть ошибка, так как сам делал задачу на списки первый раз в жизни ;) Так что кто увидит баг, кричите :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.

Сообщение отредактировано: klem4 - 20.10.2005 20:07

[volvo]

А у меня вот что получилось:

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]

Спасибо большое-большое, вы мне очень помогли .И персональное СПАСИБО volvo и klem4

[yuivanenko]

А у меня вот что получилось:

Проверяю программу для данных L1- {2;3} L2={0;0;0} L={2;3;2;3} выбивает прогграмму без всяких ответов. Подскажите почему?

[volvo]

Программа отлаживалась для случая, когда L1 содержится в списке L не с самого начала:
L1- {2;3} L2={0;0;0} L={1;2;3;2;3} - прекрасно отрабатывает... Для указанного случая придется чуть-чуть подкорректировать программу. Хотя сейчас я бы переделал программу совершенно по-другому.
Например, вот так:  sub_list.pas ( 2.45 килобайт ) Кол-во скачиваний: 356


P.S. Кстати, память в программе из 4-го поста не освобождается...

[yuivanenko]

Программа отлаживалась для случая, когда L1 содержится в списке L не с самого начала:
L1- {2;3} L2={0;0;0} L={1;2;3;2;3} - прекрасно отрабатывает... Для указанного случая придется чуть-чуть подкорректировать программу. Хотя сейчас я бы переделал программу совершенно по-другому.
Например, вот так:  sub_list.pas ( 2.45 килобайт ) Кол-во скачиваний: 356


P.S. Кстати, память в программе из 4-го поста не освобождается...

Огромное спасибо. Сейчас работает со всеми данными

Сообщение отредактировано: yuivanenko - 13.05.2010 21:07