Цифровая сортировка базы данных "Жизнь замечательных людей", страница 3

begin

sch:=sch+1;

new(p);

read(f,p^.data);

{ inc(i);}

p^.next:=head;

head:=p;

end;

end;

{----------------------------------------------------------------}

procedure index_massiv(var b:mas;head:ple;sch:longint);

var

p:ple;

begin

p:=head;

sch:=0;

while(p<>NIL) do

begin

sch:=sch+1;

b[sch]:=p;

p:=p^.next;

end;

end;

{----------------------------------------------------------------}

procedure dispose_dp(var p:pv);

var

q:pv;

begin

if (p<>NIL) then

begin

dispose_dp(p^.left);

dispose_dp(p^.right);

q:=p;

if p^.right=NIL then p:=p^.left

else

if p^.left=NIL then p:=p^.right

else

p:=p^.left;

dispose(q);

end;

end;

{----------------------------------------------------------------}

procedure dispose_list(var head:ple);

var

p:ple;

t:ple;

begin

p:=head;

while p<>NIL do

begin

t:=p^.next;

dispose(p);

p:=t;

end;

head:=NIL;

end;

{----------------------------------------------------------------}

procedure poisk(var b:mas;sch:integer;var head:ple);

var

sum:word;

i,j:integer;

str:string[20];

l,r,m,x:integer;

check:boolean;

p:ple;

begin

writeln('‚ўҐ¤ЁвҐ б㬬㠢Є« ¤ :');

readln(sum);

l:=1;r:=sch;

check:=false;

while(l<=r) do

begin

m:=round((l+r)/2);

if b[m]^.data.god=sum then

begin

check:=true;

x:=m;

break;

end;

if b[m]^.data.god<sum then l:=m+1

else r:=m-1;

end;

if check=true then

begin

{new(p);

p^.data:=b[x]^.data;

p^.next:=head;

head:=p;}

end

else writeln('€ўҐбв®а®ў б® ў«®¦Ґ®© б㬬®© ',sum,' Ґв.');

j:=x;

for i:=j-1 downto 1 do

begin

if b[i]^.data.god<>sum then break;

end;

j:=i+1;

for i:=j to sch do

begin

if b[i]^.data.god<>sum then break;

new(p);

p^.data:=b[i]^.data;

p^.next:=head;

head:=p;

end;

end;

{----------------------------------------------------------------}

procedure view(head:ple;str:string);

var

p:ple;

i,j:longint;

k:word;

ch:char;

begin

p:=head;

i:=0;k:=1;

gotoxy(1,3);

while p<>NIL do

begin

writeln(k,'.',p^.data.avtor,' ',p^.data.god,'  ',p^.data.zaglavie,' ',p^.data.page_number,' ',p^.data.izdanie);

p:=p^.next;

inc(i);

inc(k);

if (i mod 20)=0 then

begin

ch:=readkey;

if(ch=#27) then break;

clrscr;

write(str);

gotoxy(1,3);

end;

end;

end;

{----------------------------------------------------------------}

procedure digital_sort(var s:ple;l:integer);

type

quene=record

head:ple;

tail:ple;

end;

var

d:integer;

i,j,k:integer;

p:ple;

KDI: array [1..10] of byte;

Q:array[0..255] of quene;

begin

KDI[1]:=61;

KDI[2]:=62;

KDI[3]:=1;

KDI[4]:=2;

KDI[5]:=3;

{KDI[6]:=38;

KDI[7]:=39;

KDI[8]:=40;

KDI[9]:=35;

KDI[10]:=36;}

for j:=l downto 1 do

begin

for i:=0 to 255 do

begin

Q[i].tail:=ple(@Q[i].head);

end;

p:=s;

k:=KDI[j];

while(p<>NIL) do

begin

d:=p^.digit[k];

Q[d].tail^.next:=p;

Q[d].tail:=p;

p:=p^.next;

end;

p:=ple(@s);

for i:=0 to 255 do

begin

if Q[i].tail<>ple(@Q[i].head) then

begin

p^.next:=Q[i].head;

p:=Q[i].tail;

end;

end;

p^.next:=NIL;

end;

end;

{----------------------------------------------------------------}

procedure dbd(head:ple;var root:pv);

var

vr,hr:boolean;

procedure b2insert(d:zapis;var p:pv);

var

q:pv;

begin

vr:=true;

hr:=true;

if (p=NIL) then

begin

new(p);

p^.left:=NIL;

p^.right:=NIL;

p^.data:=d;

p^.bal:=0;

vr:=true;

end

ELSE

if ( compare(p^.data,d)=1) then

begin

b2insert(d,p^.left);

if (vr=true) then

begin

if (p^.bal=0) then

begin

q:=p^.left;

p^.left:=q^.right;

q^.right:=p;

p:=q;

p^.bal:=1;

vr:=false;

hr:=true;

end

ELSE

begin

p^.bal:=0;

hr:=false;

end;

end

ELSE

begin

hr:=false;

end;

end

ELSE

if ( compare(p^.data,d) = -1) then

begin

b2insert(d,p^.right);

if (vr=true) then

begin

p^.bal:=1;

hr:=true;

vr:=false;

end

ELSE

begin

if (hr=true) then

begin

if  (p^.bal>0) then

begin

q:=p^.right;

p^.right:=q^.left;

p^.bal:=0;

q^.bal:=0;

q^.left:=p;

p:=q;

vr:=true;

hr:=false;

end

ELSE

begin

hr:=false;

end;

end;

end;

end

ELSE

begin

end;

end;

var

p:ple;

begin

p:=head;

while p<>NIL do

begin

b2insert(p^.data,root);

p:=p^.next;

end;

end;

{----------------------------------------------------------------}

procedure obhod(p:pv;i:longint);

begin