Глава 2. Задача 4
Кольцевой список из элементов с ключами.
Обозначения: D – данные, next – указатель на следующий элемент, P – указатель на предыдущий элемент, K – ключ, begin – указатель на начало списка.
2.1 Листинг программы
Program Kolzevoy_Spisok;
type
ptr=^R;
R=Record
A:real;
K:integer;
next:ptr;
end;
var
nach:ptr;
nb,a,i,n:integer;
inf:real;
Procedure Init(var nach:ptr);
begin
nach:=nil;
end;
Procedure Print_Spisok(nach:ptr);
var q:ptr; i:integer;
begin
writeln('spisok:');
writeln;
i:=0;
if nach<>nil then
begin
q:=nach;
repeat
i:=i+1;
writeln(i:3,' ',q^.A:8:2,' ',q^.K);
q:=q^.next;
until q=nach;
writeln;
end;
if (nach=nil) then writeln('spisok pust');
end;
Procedure Clear_Spisok(var nach:ptr);
var q,r:ptr;
begin
if nach<>nil then
begin
q:=nach;
repeat
r:=q;
q:=r^.next;
Dispose(r);
until q=nach;
end;
nach:=nil;
end;
Procedure Dobavit_nach(var nach:ptr; inf:real);
var q,r:ptr;
begin
New(q);
if nach=nil then begin
nach:=q;
q^.next:=nach;
end
else begin
r:=nach;
while r^.next<>nach do r:=r^.next;
q^.next:=nach;
nach:=q;
r^.next:=q;
end;
q^.A:=inf;
q^.K:=nb;
nb:=nb+1;
end;
Procedure Dobavit_kon(var nach:ptr; inf:real);
var q,r:ptr;
begin
New(q);
r:=nach;
if nach<>nil then while r^.next<>nach do r:=r^.next;
if nach=nil then begin
nach:=q;
q^.next:=nach;
end
else begin
r^.next:=q;
q^.next:=nach;
end;
q^.A:=inf;
q^.K:=nb;
nb:=nb+1;
end;
Procedure Dobavit_nom(var nach:ptr; a:integer; inf:real);
var q,r:ptr; i:integer;
begin
q:=nach; i:=1;
if a<>1 then repeat
i:=i+1;
q:=q^.next;
until (i=a) or (q=nach);
if (i<>a) then writeln('nevernyi nomer')
else begin
New(r);
r^.A:=inf;
r^.K:=nb;
nb:=nb+1;
r^.next:=q^.next;
q^.next:=r;
end;
end;
Procedure Dobavit_kl(var nach:ptr; a:integer; inf:real);
var q,r:ptr;
begin
q:=nach;
if q^.K<>a then repeat
q:=q^.next;
until (q^.K=a) or (q=nach);
if (q^.K<>a) then writeln('nevernyi kluch')
else begin
New(r);
r^.A:=inf;
r^.K:=nb;
nb:=nb+1;
r^.next:=q^.next;
q^.next:=r;
end;
end;
Procedure Udalit_nach(var nach:ptr);
var q,r:ptr;
begin
if nach<>nil then begin
if nach^.next<>nach then
begin
r:=nach;
while r^.next<>nach do r:=r^.next;
q:=nach;
nach:=q^.next;
r^.next:=nach;
Dispose(q);
end
else
begin
q:=nach;
nach:=nil;
Dispose(q);
end;
end;
end;
Procedure Udalit_kon(var nach:ptr);
var q,r:ptr;
begin
r:=nach;
if nach<>nil then
begin
if nach^.next=nach then
begin
q:=nach;
nach:=nil;
Dispose(q);
end
else
begin
while r^.next^.next<>nach do r:=r^.next;
q:=r^.next;
r^.next:=nach;
Dispose(q);
end;
end;
end;
Procedure Udalit_nom(var nach:ptr; a3:integer);
var q,r:ptr; i:integer;
begin
if a3=1 then
Udalit_nach(nach)
else
begin
r:=nach; i:=1;
while (i<>a3-1) do
begin
i:=i+1;
r:=r^.next;
end;
q:=r^.next;
r^.next:=q^.next;
Dispose(q);
end;
end;
Procedure Udalit_kl(var nach:ptr; a3:integer);
var q,r:ptr;
begin
r:=nach;
if r^.K=a3 then
Udalit_nach(nach)
else
begin
while (r^.next^.K<>a3) do
r:=r^.next;
q:=r^.next;
r^.next:=q^.next;
Dispose(q);
end;
end;
Procedure Dobav_Element(var nach:ptr);
var a2,a3:byte; i:integer;
b:boolean;
begin
repeat
writeln('1 - v nachalo');
writeln('2 - v konec');
writeln('3 - posle elementa');
writeln('4 - posle klucha');
readln(a2);
if (a2<>1) and (a2<>2) and (a2<>3) and (a2<>4) then b:=false else b:=true;
until b;
if a2=3 then
begin
write('nomer:');
readln(a3);
end;
if a2=4 then
begin
write('kluch:');
readln(a3);
end;
write('element:');
readln(inf);
if (a2=1) then
Dobavit_nach(nach,inf);
if (a2=2) then
Dobavit_kon(nach,inf);
if (a2=3) then
Dobavit_nom(nach,a3,inf);
if (a2=4) then
Dobavit_kl(nach,a3,inf);
end;
Procedure Udal_Element(var nach:ptr);
var a2,a3:byte; i:integer;
b:boolean;
begin
repeat
writeln('1 - iz nachala');
writeln('2 - iz konca');
writeln('3 - ukazannyi element');
writeln('4 - ukazannyi kluch');
readln(a2);
if (a2<>1) and (a2<>2) and (a2<>3) and (a2<>4) then b:=false else b:=true;
until b;
if a2=3 then
begin
write('nomer:');
readln(a3);
end;
if a2=4 then
begin
write('kluch:');
readln(a3);
end;
if (a2=1) then
Udalit_nach(nach);
if (a2=2) then
Udalit_kon(nach);
if (a2=3) then
Udalit_nom(nach,a3);
if (a2=4) then
Udalit_kl(nach,a3);
end;
begin
nb:=1;
Init(nach);
write('chislo dobavlennyh elementov spiska:');
readln(n);
for i:=1 to n do begin
Dobav_Element(nach);
Print_Spisok(nach);
readln;
end;
write('chislo udalennyh elementov spiska:');
readln(n);
for i:=1 to n do begin
Udal_Element(nach);
Print_Spisok(nach);
readln;
end;
Clear_Spisok(nach);
end.