Форум «Всё о Паскале» > Стек и очередь

Помощь - Поиск - Пользователи - Календарь

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

Aleks

21.11.2005 17:36

Задание: Составить программу, которая из кольцевого списка из 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

21.11.2005 17:53

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.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.