Помощь - Поиск - Пользователи - Календарь
Полная версия: Односвязный список
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
*alt
Задача
Проверить, содержатся ли элементы списка А в списке В в указанном списком А порядке.

Помогите, пожалуйста. Как реализовать решение??
Подкиньте идейку... с чего начать.... или алгоритм посоветуйте
Артемий
B FAQ
volvo
*alt, для начала - условие уточни: допустим, есть 2 списка -
A = <1, 2, 3, 4, 5>
B = <1, 2, 2, 3, 3, 4, 2, 3, 4, 5>

То есть, список A не является составной частью списка B (в списке B нет неразрывной последовательности 1,2,3,4,5), но при этом все элементы A входят в состав B, причем в том же порядке... Значит ли это, что ответ на первоначальный вопрос - "Да"?
Гость
Честно хз. В задачнике дословно написана вышеизложенная формулировка
Но я думаю, что порядок должен быть именно таким, как это записанно в А, т.е. за 4 должно идти 5, иначе порядок нарушается...
*alt
Вот я такой код сделал, НО чего-то на счёт порядка у меня проблемы
То есть программа смотрит просто вхождение Элементов((((
Подскажите что делать....
Код

type
  Tinf = integer;
  Tptr = ^Tlist;
  Tlist = record
    inf:Tinf;
    next:Tptr;
  end;

var
  A,B:Tptr;

procedure create_list (var l:Tptr );
var p:Tptr; e:Tinf;
  begin
    l:=nil;
    while not eoln do
      begin
        read (e);
        new(p);
        p^.inf:=e;
        p^.next:=l;
        l:=p;
      end;
    readln
  end;

function search (L1,L2:Tptr):boolean;
  var p,q:Tptr; ok:boolean;
    begin
      ok:=true;
      p:=L1; q:=L2;
      while (p<>nil) do
        begin
          while (q<>nil) do
            begin
              if p^.inf = q^.inf then
                ok:=false;
              q:=q^.next;
            end;
          p:=p^.next;
        end;
    search:=not ok;
    end;


begin {main}

  write ('Введите элементы списка A: ');
  create_list(A);
  write ('Введите элементы списка B: ');
  create_list(B);

  if search(A,B) then writeln ('Содержится')
  else writeln ('Не Содержится');

  readln;
end.
volvo
Вноси данные в список не в обратном, а в прямом порядке (так, как они записаны в строке), тогда сможешь делать так:

function search (L1, L2:Tptr):boolean;
var pl_1, pl_2: tptr;
begin

pl_1 := L1;
pl_2 := L2;
while (pl_1 <> nil) and (pl_2 <> nil) do begin
if L1^.inf = pl_2^.inf then begin
pl_1 := L1;
while (pl_1 <> nil) and (pl_2 <> nil) and (pl_1^.inf = pl_2^.inf) do begin
pl_1 := pl_1^.next; pl_2 := pl_2^.next;
end;
end
else pl_2 := pl_2^.next;
end;

search := pl_1 = nil;
end;

*alt
Так значит получаеися??
Код

type
  Tinf = integer;
  Tptr = ^Tlist;
  Tlist = record
    inf:Tinf;
    next:Tptr;
  end;

var
  A,B:Tptr;

procedure create_list (var L:Tptr );
var q,p:Tptr; e:Tinf;
  begin
    L:=nil;
    while not eoln do
      begin
        new(p);
        read (e);
        p^.inf:=e;
        p^.next:=nil;
        if l=nil then l:=p
        else q^.next:=p;
        q:=p;
      end;
    readln
  end;

function search (L1, L2:Tptr):boolean; {by Volvo (c)=)}
var pl_1, pl_2: tptr;
begin

  pl_1 := L1;
  pl_2 := L2;
  while (pl_1 <> nil) and (pl_2 <> nil) do
    begin
      if L1^.inf = pl_2^.inf then
      begin
        pl_1 := L1;
        while (pl_1 <> nil) and (pl_2 <> nil) and (pl_1^.inf = pl_2^.inf) do
          begin
            pl_1 := pl_1^.next;
            pl_2 := pl_2^.next;
          end;
      end
      else pl_2 := pl_2^.next;
    end;

  search := pl_1 = nil;
end;

procedure del_list (var h:Tptr);
var p:Tptr;
  begin
    while h<>nil do
      begin
        p:=h;
        h:=h^.next;
        dispose (p);
      end;
  end;


begin {main}

  write ('Введите элементы списка A: ');
  create_list(A);
  write ('Введите элементы списка B: ');
  create_list(B);

  if search(A,B) then writeln ('Содержится')
  else writeln ('Не Содержится');

  del_list (A);
  del_list (B);

  readln;
end.
volvo
Получается, что так... А что не проверишь сам-то? Лучший способ убедиться, что все работает...
*alt
Volvo, спасибо!!! В сё в порядке - асё хороршо!!!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.