Стек и очередь, кольцевой список Опции

[Aleks]

Задание: Составить программу, которая из кольцевого списка из n элементов удаляет в порядке просмотра кольца каждый k-й элемент до тех пор, пока в списке не останется один элемент. Распечатать номера удаленных элементов.

в некоторых случаях прога глючит т.е., если внести числа с 1 по 9 эл. и end (всего 10 элементов)
внести шаг удаления 3
при проходе в некоторых случаях отображаются "левые" элементы - "J 1 F" , " "

при вводе 4 эл. и end (всего 5 элементов), шаг 3
Error 204: Invalid pointer operation. -> dispose( r ); (стр.4 снизу)

я думаю что не правильно сделал удаление из кольцевого списка, из-за чего и появляются ошибки: Error 204: Invalid pointer operation , или неизвестные элементы

Подскажите плиз

Код

uses Crt, WinDos;

type
 {Указатель на элемент списка}
 PTR=^Sp;
 {Тип данный для записи элемента двусвязного списка}
 Sp=record
   inf: String;{Данные}
   L1: PTR;  {Указатель на следующий элемент списка}
   L2: PTR;  {Указатель на предыдущий элемент списка}
 end;

var
 k: PTR;  {Указатель текущего элемента списка}
 f: PTR;  {Указатель начального элемента списка}
 r: PTR;  {Указатель конечного элемента списка}
 i,j: PTR;
 n: Integer; {Количество}
 ii,kk: Integer;
 Delt: Boolean;

procedure NewSpisok; {Создаем спиок}
begin
 New(k); k^.L1:=nil; k^.L2:=nil;
 write('Введите следущий элемент списка ');Readln(k^.inf);
 f:=k;   r:=k;
 while k^.inf<>'end' do
 begin
   j:=k;  new(k);
   write('Введите следущий элемент списка (или end) ');
   Readln(k^.inf);
   k^.L1:=nil;  k^.L2:=j;
   j^.L1:=k;
   r:=k;
   inc(n);
 end;
 {Замыкаем список}
 r^.L1:=f;
end;

procedure DeleteK;  {удаляем k-ый элемент}
begin
 if ii=kk then
 begin
   writeln('Удаляем элемент ',r^.inf, ' - ',ii,'-ый  элемент');
   j:=r^.L1;  if j<>nil then j^.L2:=r^.L2;
   i:=r^.L2;  if i<>nil then i^.L1:=r^.L1;
   dispose(r);
   if j<>nil then r:=j else r:=i;
   dec(n);
   ii:=0;
   Delt:=true;
 end;
end;

begin
 clrscr;
 writeln('Количество свободной памяти  ',memavail);

 n:=0;   {Количество элементов в списке}
 NewSpisok;   {Создаем список}
 write('k=');readln(kk); {указываем шаг}
 ii:=0;
 writeln('Начинаем обход списка');
 Delt:=false;
 {Пока не остался один элемент}
 while n<>0 do
 begin
   {Если этот и слежующий элемент непустые , переходим к следующему}
   if (r<>nil) and (r^.L1<>nil) and not Delt then
   begin
     r:=r^.L1;
   end;
   Inc(ii);
   writeln('Смотрим элемент ',r^.inf,' - ',ii,'-ый элемент');
   if Delt then Delt:=false;
   DeleteK;  {Если попался k-ый элемент , удаляем и печатаем номер}
 end;
 writeln('Остался элемент ',r^.inf);
 dispose (r);

 writeln('Количество свободной памяти  ',memavail);
 readln;
end.

[volvo]

Aleks, я тебе на параллельном форуме подсказал, но теперь я полностью изменю структуру программы. Вот так будет лучше:

uses Crt;

type
  PList = ^TList;
  TList = record
    inf: string;
    prev, next: PList;
  end;

var
  pos, count: integer;

function MakeList(var head: PList): integer;
var
  s: string;
  last, p: PList;
  count: integer;
begin
  head := nil; last := nil;
  count := 0;
  repeat

    write('enter the element: '); readln(s);

      new(p); inc(count);
      with p^ do begin
        inf := s;
        next := nil; prev := last;
      end;
      if head = nil then head := p
      else last^.next := p;

      last := p


  until s = 'end';
  last^.next := head;
  head^.prev := last;

  MakeList := count - 1;
end;

function DeleteItem(p: PList; every: integer): plist;
begin
  repeat

    p := p^.next;
    inc(pos); if pos > count then pos := 1;

    if p^.inf <> 'end' then dec(every);

  until every = 1;
  p^.next^.prev := p^.prev;
  p^.prev^.next := p^.next;
  DeleteItem := p^.next;

  dispose(p);
end;

procedure PrintList(head: PList);
begin
  while head^.inf <> 'end' do
    head := head^.next;
  head := head^.next;

  while head^.inf <> 'end' do begin
    write(head^.inf:5);
    head := head^.next;
  end;
  writeln;
end;

var
  pt, root: PList;
  every: integer;
begin
  count := makelist(root);
  printlist(root);
  writeln;

  every := 3; pos := 1;
  pt := root;
  repeat
    pt := DeleteItem(pt, every);
    printlist(pt);
    writeln('#', pos:3, ' was deleted ...');
    writeln;
    dec(count);
  until count = 1;
end.