Задача на двумерный список Опции

[habi]

Задача. используя динамические списки, найти в массиве последнию группу положительных элементов, и удалить её.
Проблема: не могу установить указатели конца(вроде установил) и начала последней группы положительных элементов.
Если есть другие предложения по алгоритму, просьба высказать.
Вот набросал за сегодня :

program labа;
uses
  crt;
type
  ukaz=^mas;
  mas=record
        chisl:integer;
        next:ukaz;
        pred:ukaz;
      end;
Var
  first, tek, tmp, last,listkon,listnach: ukaz;
  i,j,n,nach,konec,temp:integer;
{----------------------------------------------------------------------------}
procedure CreateSpisok(n:integer);
Begin
  write('Vvedite koli4estvo 4isel massiva->');
  readln(n);
  new(first);
  first^.pred:=nil;
  first^.chisl:=random(200)-50;
  tek:=first;
  for i:=1 to n do
  begin
    new(tek^.next);
    tek^.next^.chisl:=random(200)-50;
    tek^.next^.pred:=tek;
    write(tek^.chisl:5);
    tek:=tek^.next;
  end;
  tek^.next:=nil;
  writeln;
end;
{----------------------------------------------------------------------------}
Function SearchLastPolGroup: ukaz;
var
  Pol:ukaz;
begin
  Pol:=first;
  while (pol^.chisl<=0)  and (pol^.next<>nil) do
    pol:=pol^.next;
  if pol^.chisl>0 then
    SearchLastPolGroup:=pol
  else
    SearchLastPolGroup:=nil;
end;
{----------------------------------------------------------------------------}
Procedure DisposeRec;
var
  temp:ukaz;
begin
  tek:=first;
  repeat
    temp:=tek^.next;
    tek:=temp;
  until  tek=nil;

end;
{----------------------------------------------------------------------------}
BEGIN
  randomize;
  clrscr;
  writeln;
  writeln('Programma formiruet dinamy spisok, i perenosit ponextniy gruppu pol elementov');
  writeln('v nachalo spiske dinam, i zamenaet ego nylami, gruppa eto elementi > 2 shtuk');  writeln;
  textcolor(red);
  writeln('Svobodnaja pamjat do nachala ',memavail,' kb');
  writeln;
  CreateSpisok(n);
  tek:=first;
  i:=1;
  while tek^.next<>nil do
  begin
    if tek^.chisl>0 then
    begin
      temp:=temp+1;
      if temp>=2 then
      begin
        nach:=i-temp+1;
        konec:=i;
        listkon:=tek;
      end;
    end
    else
    temp:=0;
    tek:=tek^.next;
    i:=i+1;
  end;
{----------------------------------------------------------------------------}
  textcolor(blue);
  writeln;
  writeln('nachalo last pol. group-->',nach:3,' konecec last pol.group-->', konec:3);
  writeln('idet perestanovka i obnulenie last pol. group, najmite Enter');
  readln;
  tek:=first;

  for i:=1 to konec-1 do
    tek:=tek^.next;
    dispose(tek);
  for i:=konec downto nach do
  begin
    temp:=tek^.chisl;
    tmp:=tek;
   for j:=konec-1 downto 1 do
    begin
      tmp^.chisl:=tmp^.pred^.chisl;
      tmp:=tmp^.pred;
    end;
    first^.chisl:=temp;
  end;
{----------------------------------------------------------------------------}

   listnach:=first;tek:=listnach;
   repeat
   tmp:=tek^.next;
   dispose(tek);
   tek:=tmp;
   until tek=listkon;
   {----------}
  writeln;
  textcolor(lightblue);
  tek:=first;
  if SearchLastPolGroup<>nil then
    while tek^.next<>nil do
    begin
      write(tek^.chisl:5);
      tek:=tek^.next;
    end
  else
  writeln('pol. grup elementov net');
  writeln;
  writeln;
  writeln('Svobodnaja pamjat v processe ',memavail,' kb');
  readln;
  DisposeRec;
  textcolor(green);
  writeln;
  writeln('Svobodnaja pamjat posle o4ustku ',memavail,' kb');
  readln;
end.

[volvo]

Значит, смотри, вот твое задание, но без украшательств:

type
  ukaz = ^mas;
  mas = record
    chisl:integer;
    next, pred: ukaz;
  end;

procedure create_list(var first, last: ukaz);
var
  i, n: integer;
  p: ukaz;
begin
  write('n = '); readln(n);

  first := nil; last := nil;
  for i := 1 to n do begin
    new(p);
    p^.chisl := random(200) - 100;;
    p^.next := nil;
    p^.pred := last;

    if first = nil then first := p
    else last^.next := p;

    last := p;
  end;

end;

procedure delete_list(var start: ukaz);
var T: ukaz;
begin
  while start <> nil do begin
    T := start;
    start := start^.next;
    dispose(T);
  end;
  start := nil;
end;

procedure print(start: ukaz);
begin
  while start <> nil do begin
    write(start^.chisl:4);
    start := start^.next;
  end;
  writeln;
end;

function has_pred(p: ukaz): boolean;
begin
  has_pred := (p <> nil) and (p^.pred <> nil);
end;
function has_next(p: ukaz): boolean;
begin
  has_next := (p <> nil) and (p^.next <> nil);
end;

var
  start, finish: ukaz;
  beg_delete, end_delete, T: ukaz;

begin
  create_list(start, finish);
  print(start);
  { До этого момента все должно быть ясно - создали список, напечатали... }

  { теперь начинается сам алгоритм: }

  { сначала ищем конец положит. последовательности: от хвоста списка... }
  end_delete := finish;
  { ... идем к началу до тех пор, пока не дойдем до nil или не будет найден НЕотриц. элемент }
  while (end_delete <> nil) and (end_delete^.chisl < 0) do
    end_delete := end_delete^.pred;

  { смотрим, что получилось: если NIL, значит нет полож. элементов, выходим }
  if end_delete = nil then writeln('nothing to delete')
  else begin
    { а вот раз мы тут, значит, полож. элементы есть. Ищем начало этой последовательности }

    { начинаем от предыд. элемента }
    beg_delete := end_delete;
    { пока есть пред. элемент и он положительный ...  }
    while has_pred(beg_delete) and (beg_delete^.pred^.chisl > 0) do
      beg_delete := beg_delete^.pred; { ... продвигаемся назад... }

    { продвижение закончено... Что имеем? }

    {
      Если мы добрались до элемента, у которого нет предыдущего -
      значит это START - начало списка
    }
    if beg_delete^.pred = nil then begin
      beg_delete := start; { <--- это можно бы и не делать, только для иллюстрации, мы и так здесь }
      start := end_delete^.next; { Новое начало списка будет ПОСЛЕ end_begin, все остальное удалится }
    end;

    { если у начала найденной последовательности есть пред. элемент, это не самое начало списка }
    if has_pred(beg_delete) then
      beg_delete^.pred^.next := end_delete^.next; { тогда связываем НЕудаляемое начало с концом ... }
    if has_next(end_delete) then
      end_delete^.next^.pred := beg_delete^.pred; { ... и конец - с началом }

    {
      а вот теперь окончательно разделяем 2 списка: за посл. удаляемым элементом ставим NIL
      и получаем 2 независимых списка: тот который надо удалить - начинается в BEG_DELETE, и
      тот, который остатся - начинается (как и прежде) в START...
    }
    if end_delete <> nil then
      end_delete^.next := nil;

    delete_list(beg_delete); { удаляем ненужное }
    print(start); { печатаем что осталось }
  end;

  delete_list(start); { и освобождаем память... }
end.

Разберись с тем, как оно работает, прежде чем навешивать "рюшечки", иначе потом опять будет сложнее разобраться...