DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFileVerbose
    Names: »tbinspas«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »tbinspas« 

TextFileVerbose

binspas = pascal list.no
program binsearch(input, output);
const
sp = ' ';
ls = 16000;
il = 5; (* indent *)
balanced = 0;
left = 1;
right = 2;

type
left_right = left..right;
recptr = ^ rec;
rec = record
desc : array [ left_right ] of recptr;
bal  : integer;
count: integer;
key  : integer; (* index in chars *)
end;

var
chars : packed array [ 0 .. ls ] of iso;
free : integer; (* index in chars *)
last_char : integer;
root : recptr;
x    : recptr;
grown : boolean;

function get_item(x: recptr): boolean;
label 7913;
var
ch : iso;
begin
get_item := false; (* assume nothing read *)
last_char := free;
while input^ <= sp do
begin
if eof(input) then goto 7913;
get(input);
end;
repeat
chars[last_char] := input^; get(input);
last_char := last_char + 1;
until input^ <= sp;
chars[last_char] := sp;
get_item := true;
7913:; (* end *)
end;

procedure print_item(p: recptr);
var
n: integer;
begin
n := p^.key;
while chars[n] <> nul do begin write (output, chars[n]); n := n + 1; end;
writeln (output, p^.count:4);
end;

procedure print_tree (p: recptr; n: integer);
begin
if p <> nil then
begin
print_tree(p^.desc[left], n+1);
write (output, sp:n*il);
print_item (p);
print_tree (p^.desc[right], n+1);
end;
end;

function insert(var p: recptr; var x: recptr): boolean;
begin
insert := true;
p := x;
free := last_char + 1;
if last_char <> -1 then chars[last_char] := nul;
new (x);
with x^ do
begin
desc[left] := nil;
desc[right] := nil;
bal := balanced;
count := 1;
key := free;
end;
end;

procedure initialize;
begin
root := nil;
last_char := -1;
grown := insert (x, x);
end;

procedure search (var x: recptr; var p: recptr; var grown: boolean);
var
xi, pi: integer;
branch: left_right;

procedure balance (branch: left_right);
var
other: left_right;
q, r : recptr;
begin
if p^.bal = balanced then p^.bal := branch else
begin
if p^.bal = branch then
begin (* rebalance *)
if branch = left then other := right else other := left;
q := p^.desc[branch]; r := q^.desc[other];
if q^.bal = branch then
begin (* single node rotate *)
p^.desc[branch] := r; q^.desc[other] := p; p^.bal := balanced; p := q;
end else
begin (* double node rotate *)
q^.desc[other] := r^.desc[branch]; r^.desc[branch] := q;
p^.desc[branch]:= r^.desc[other] ; r^.desc[other]  := p;
if r^.bal = branch then p^.bal := other  else p^.bal := balanced;
if r^.bal = other  then q^.bal := branch else q^.bal := balanced;
p := r;
end;
end; (* rebalance *)
p^.bal := balanced; grown := false;
end;
end;

begin
if p = nil then grown := insert (p, x) else
begin
xi := x^.key; pi := p^.key;
while chars[xi]=chars[pi] do
begin xi := xi+1; pi := pi+1; end;
if (chars[xi]=sp) and (chars[pi]=nul) then p^.count := p^.count+1 else
begin
if chars[xi] < chars[pi] then branch := left else branch := right;
search (x, p^.desc[branch], grown);
if grown then balance (branch);
end;
end;
end;

begin (* program *)
initialize;
while get_item(x) do
begin grown := false; search (x, root, grown) end;
print_tree(root, 0);
end.
«eof»