Дискуссионный математический форумМатематический форум
Математический форум Math Help Planet

Обсуждение и решение задач по математике, физике, химии, экономике

Теоретический раздел
Часовой пояс: UTC + 3 часа [ Летнее время ]
новый онлайн-сервис
число, сумма и дата прописью

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ 1 сообщение ] 
Автор Сообщение
 Заголовок сообщения: Очередь в паскале
СообщениеДобавлено: 09 ноя 2012, 18:16 
Не в сети
Начинающий
Зарегистрирован:
22 дек 2011, 18:41
Сообщений: 32
Cпасибо сказано: 0
Спасибо получено:
0 раз в 0 сообщении
Очков репутации: 1

Добавить очки репутацииУменьшить очки репутации
Народ не кто с л2 не сталкивался? (двусторонняя очередь, дек)
проблемка в модуле с функцией копирования
[spoiler=]unit L2;
interface
type PList=^TList;
Telem=integer;
TLIst=record
data:Telem;
next:Plist;
prev:Plist;
end;
PL2=^CL2;
CL2=object
private
head,tail:Plist;
public
constructor Init;
constructor Copy(Li:PL2);
destructor Done;
procedure MakeEmpty;
function IsEmpty:boolean;
procedure pointstart; {передвинуть указат в начало}
procedure pointfinish; {передвинуть указат в конец}
function Isfinish:boolean; {конец ?}
function Isstart:boolean; {начало ?}
procedure pointForwardnext; {передвинуть указат вперед}
procedure pointForwardprev; {передвинуть указат назад}
procedure insertnext(x:Telem); {вставить за указатель} {добавить элемент левее указателя}
procedure insertprev(x:telem); {добавить элемент правее указателя}
procedure extractnext(var x:telem); {взять голову и убрать} {изьять элемент левее указателя}
procedure extractprev(var x:telem); {изьять элемент правее указателя}
procedure changehead(x:telem); {изменить элемент левее указателя}
procedure changetail(x:telem); {изменить элемент правее указателя}
procedure seeheadnext(var x:telem); {посмотреть за указателем }
procedure seeheadprev(var x:telem); {посмотреть перед указателем}
procedure delhead;
procedure deltail;
function geterror(errorcode:byte):byte;
function clearerror(mask:byte):byte;
end;
implementation
uses crt;
constructor cl2.init;
var t:plist;
begin
new(t);
t^.prev:=t;
t^.next:=t;
head:=t;
tail:=t;
errorcode:=0;
end;

constructor cl2.copy(li:pl2);
var t,r:plist;
I:byte;
li1:pl2;
x:telem;
begin i:=0;
if li1<>nil then begin // writeln('breakpoint ',i); inc(i);
new(t);
li^.seeheadnext(x);
new(r);
r:=li^.tail^.next;
// writeln('oldheadlist: ',x);
new(li1,init);
li1:=li; // writeln('breakpoint ',i); inc(i);
tail:=t; // writeln('breakpoint ',i); inc(i);
head:=t;
tail^.next:=t;
t:=li1^.tail;
li1^.pointstart;
while not(li1^.isfinish) do begin
li1^.seeheadnext(x);
insertnext(x);
seeheadnext(x);
// writeln('dato ',x); inc(i);
t:=li1^.tail^.next;
li1^.tail^.next:=t^.next;
end;
li1^.pointstart;
li1^.tail^.next:=r;
li1^.seeheadnext(x);
// writeln('here is the new headposition of list: ',x);
end
else fail;
end;


destructor cl2.done;
begin
makeempty;
dispose(plist(head));
end;

procedure cl2.makeempty;
var t:plist;
begin
if head^.next<>head then
begin
t:=Plist(head)^.next;
head^.next:=nil;
head:=t;
while head^.next<>nil do
begin
head:=t^.next;
dispose(t);
t:=head;
end;
t^.next:=t;
tail:=head;
end;
end;

function cl2.IsEmpty:boolean;
var t:Plist;
begin
if (head^.next=head) then IsEmpty:=true else Isempty:=false;
end;


procedure cl2.pointstart;
begin
tail:=head;
end;

procedure cl2.pointfinish;
begin
head:=tail;
end;

function cl2.isfinish:boolean;
begin
isfinish:=(tail=head^.next);
end;


function cl2.isstart:boolean;
begin
isstart:=(head=tail^.prev);
end;

procedure cl2.pointforwardnext;
begin
if isfinish then errorcode:=1 {geterror}
else begin
tail^.next:=tail^.next^.next;
clearerror(254);
end;
end;

procedure cl2.pointforwardprev;
begin
if isstart then errorcode:=1 {geterror}
else begin
tail^.prev:=tail^.prev^.prev;
clearerror(254);
end;
end;

procedure cl2.insertnext(x:telem);
var t:plist;
begin
new(t);
t^.next:=tail^.next;
t^.data:=x;
tail^.next:=t;
{clearerror();}
end;

procedure cl2.insertprev(x:telem);
var t1:plist;
begin
new(t1);
t1^.prev:=tail^.prev;
t1^.data:=x;
tail^.prev:=t1;
{clearerror();}
end;

procedure cl2.extractnext(var x:telem);
var t:plist;
begin
if isfinish or isempty then geterror(4) {seterror для маски}
else
begin
t:=tail^.next;
x:=t^.data;
tail^.next:=t^.next;
dispose(t);
clearerror(251);
end;
end;

procedure cl2.extractprev(var x:telem);
var t:plist;
begin
if isstart or isempty then geterror(4) {seterror для маски}
else
begin
t:=tail^.prev;
x:=t^.data;
tail^.prev:=t^.prev;
dispose(t);
clearerror(251);
end;
end;

procedure cl2.changehead(x:Telem);
begin
if isfinish then geterror(16)
else
begin
tail^.next^.data:=x;
clearerror(239);
end;
end;

procedure cl2.changetail(x:Telem);
begin
if isstart then geterror(16)
else
begin
tail^.prev^.data:=x;
clearerror(239);
end;
end;

procedure cl2.seeheadnext(var x:telem);
begin
if isempty then geterror(8)
else
begin
x:=tail^.next^.data;
clearerror(247);
end;
end;

procedure cl2.seeheadprev(var x:telem);
begin
if isempty then geterror(8)
else
begin
x:=tail^.prev^.data;
clearerror(247);
end;
end;

procedure cl2.delhead;
var t:plist;
begin
if isfinish then geterror(32)
else
begin
t:=tail^.next;
tail^.next:=t^.next;
dispose (t);
clearerror (223);
end;
end;

procedure cl2.deltail;
var t:plist;
begin
if isstart then geterror(32)
else
begin
t:=tail^.prev;
tail^.prev:=t^.prev;
dispose (t);
clearerror (223);
end;
end;


function cl2.geterror(errorcode:byte):byte;
begin
geterror:=errorcode;
end;

function cl2.clearerror(mask:byte):byte;
begin
clearerror:=errorcode and mask;
end;

end.[/spoiler]

Вернуться к началу
 Профиль  
Cпасибо сказано 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему      Страница 1 из 1 [ 1 сообщение ]

 Похожие темы   Автор   Ответы   Просмотры   Последнее сообщение 
Оценить очередь к банкомату

в форуме Комбинаторика и Теория вероятностей

DewDrop

5

292

19 июн 2019, 14:59

Сколько способов встать в очередь

в форуме Комбинаторика и Теория вероятностей

Natali_05

13

831

07 дек 2017, 13:39

Односвязный список в паскале

в форуме Информатика и Компьютерные науки

netnuclear

0

266

30 ноя 2022, 16:21

Интерполяция, полиномы Лагранжа в паскале. Недочет в коде

в форуме Численные методы

Nichtswisser

0

1312

21 апр 2014, 23:57


Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  

Яндекс.Метрика

Copyright © 2010-2023 MathHelpPlanet.com. All rights reserved