1
2%   File   : LOGARR.PL
3%   Author : Mostly David H.D.Warren, some changes by Fernando Pereira
4%   Updated: 24 September 1984
5%   Purpose: Extendable arrays with logarithmic access time.
6
7/*  LOGARITHMIC ARRAYS.
8
9    An array extends from 0 to 2**Size - 1, where Size is a multiple of 2.
10    Note that 2**Size = 1<<Size.
11
12    External interface.
13
14    new_array(A) returns a new empty array A.
15
16    is_array(A) checks whether A is an array.
17
18    aref(Index,Array,Element) unifies Element with Array[Index],
19	or fails if Array[Index] has not been set.
20
21    arefa(Index,Array,Element) is as aref/3, except that it unifies
22	Element with a new array if Array[Index] is undefined.
23	This is useful for multidimensional arrays implemented
24	as arrays of arrays.
25
26    arefl(Index,Array,Element) is as aref/3, except that Element
27	appears as '[]' for undefined cells.
28
29    aset(Index,Array,Element,NewArray) unifies NewArray with the
30	result of setting Array[Index] to Element.
31
32    array_to_list(Array,List) returns a list of pairs Index-Element
33	of all the elements of Array that have been set.
34
35	In the interests of uniformity, R.A.O'K used the Prolog source
36	code tidier on this file; this is not its original layout.  He
37	made no algorithmic changes, however.
38*/
39
40:- module(logarr).			% SEPIA header
41:- export
42	new_array/1,
43	is_array/1,
44	aref/3,
45	arefa/3,
46	arefl/3,
47	aset/4,
48	array_to_list/2.
49
50/*
51:- mode
52	aref(+, +, ?),
53	arefa(+, +, ?),
54	arefl(+, +, ?),
55	array_to_list(+, -),
56	aset(+, +, +, -),
57	array_item(+, +, +, +, ?),
58	is_array(+),
59	new_array(-),
60	not_undef(+),
61	subarray(+, +, ?),
62	subarray_to_list(+, +, +, +, ?, ?),
63	update_subarray(+, +, ?, ?, -).
64*/
65
66new_array(array($($,$,$,$),2)).
67
68
69is_array(array(_,_)).
70
71
72aref(Index, array(Array,Size), Item) :-
73	check_int(Index),
74	Index < 1<<Size,
75	N is Size-2,
76	Subindex is (Index>>N) /\ 3,
77	array_item(Subindex, N, Index, Array, Item).
78
79
80array_to_list(array($(A0,A1,A2,A3),Size), L0) :-
81	N is Size-2,
82	subarray_to_list(0, N, 0, A0, L0, L1),
83	subarray_to_list(1, N, 0, A1, L1, L2),
84	subarray_to_list(2, N, 0, A2, L2, L3),
85	subarray_to_list(3, N, 0, A3, L3, []).
86
87
88arefa(Index, array(Array,Size), Item) :-
89	check_int(Index),
90	Index < 1<<Size,
91	N is Size-2,
92	Subindex is (Index>>N) /\ 3,
93	array_item(Subindex, N, Index, Array, Item), !.
94arefa(_, _, Item) :-
95	new_array(Item).
96
97
98arefl(Index, array(Array,Size), Item) :-
99	check_int(Index),
100	Index < 1<<Size,
101	N is Size-2,
102	Subindex is (Index>>N) /\ 3,
103	array_item(Subindex, N, Index, Array, Item), !.
104arefl(_, _, []).
105
106
107aset(Index, array(Array0,Size0), Item, array(Array,Size)) :-
108	check_int(Index),
109	enlarge_array(Index, Size0, Array0, Size, Array1),
110	update_array_item(Size, Index, Array1, Item, Array).
111
112
113check_int(I) :-
114	integer(I), !.
115check_int(X) :-
116	write('Array index not integer: '), write(X), nl,
117%	trace,
118	fail.
119
120% Guts
121
122enlarge_array(I, Size, Array, Size, Array) :-
123	I < 1<<Size, !.
124enlarge_array(I, Size0, Array0, Size, Array) :-
125	Size1 is Size0 + 2,
126	Array1 = $(Array0,$,$,$),
127	enlarge_array(I, Size1, Array1, Size, Array).
128
129
130array_item(0, 0, _, $(Item,_,_,_), Item) :- !,
131	not_undef(Item).
132array_item(0, N, Index, $(Array,_,_,_), Item) :-
133	N1 is N-2,
134	Subindex is (Index >> N1) /\ 3,
135	array_item(Subindex, N1, Index, Array, Item).
136array_item(1, 0, _, $(_,Item,_,_), Item) :- !,
137	not_undef(Item).
138array_item(1, N, Index, $(_,Array,_,_), Item) :-
139	N1 is N-2,
140	Subindex is (Index >> N1) /\ 3,
141	array_item(Subindex, N1, Index, Array, Item).
142array_item(2, 0, _, $(_,_,Item,_), Item) :- !,
143	not_undef(Item).
144array_item(2, N, Index, $(_,_,Array,_), Item) :-
145	N1 is N-2,
146	Subindex is (Index >> N1) /\ 3,
147	array_item(Subindex, N1, Index, Array, Item).
148array_item(3, 0, _, $(_,_,_,Item), Item) :- !,
149	not_undef(Item).
150array_item(3, N, Index, $(_,_,_,Array), Item) :-
151	N1 is N-2,
152	Subindex is (Index >> N1) /\ 3,
153	array_item(Subindex, N1, Index, Array, Item).
154
155
156not_undef($) :- !,
157	fail.
158not_undef(_).
159
160
161%% [BEFORE OPEN-CODING 'subarray']
162%%
163%% array_item(0,Index,Item,Item) :- !,
164%%	not_undef(Item).
165%% array_item(N,Index,Array,Item) :-
166%%	N1 is N-2,
167%%	Subindex is (Index >> N1) /\ 3,
168%%	subarray(Subindex,Array,Array1),
169%%	array_item(N1,Index,Array1,Item).
170%%
171%% subarray(0,$(X,_,_,_),X).
172%% subarray(1,$(_,X,_,_),X).
173%% subarray(2,$(_,_,X,_),X).
174%% subarray(3,$(_,_,_,X),X).
175
176update_array_item(0, _, _, NewItem, NewItem) :- !.
177update_array_item(N, Index, Array, NewItem, NewArray) :-
178	N1 is N-2,
179	Subindex is (Index >> N1) /\ 3,
180	update_subarray(Subindex, Array, Array1, NewArray1, NewArray),
181	update_array_item(N1, Index, Array1, NewItem, NewArray1).
182
183
184update_subarray(I, $, X, X1, Array) :- !,
185	update_subarray(I, $($,$,$,$), X, X1, Array).
186update_subarray(0, $(W,X,Y,Z), W, W1, $(W1,X,Y,Z)).
187update_subarray(1, $(W,X,Y,Z), X, X1, $(W,X1,Y,Z)).
188update_subarray(2, $(W,X,Y,Z), Y, Y1, $(W,X,Y1,Z)).
189update_subarray(3, $(W,X,Y,Z), Z, Z1, $(W,X,Y,Z1)).
190
191
192subarray_to_list(K, 0, M, Item, [N-Item|L], L) :-
193	not_undef(Item), !,
194	N is K+M.
195subarray_to_list(K, N, M, $(A0,A1,A2,A3), L0, L) :-
196	N > 0, !,
197	N1 is N-2,
198	M1 is (K+M) << 2,
199	subarray_to_list(0, N1, M1, A0, L0, L1),
200	subarray_to_list(1, N1, M1, A1, L1, L2),
201	subarray_to_list(2, N1, M1, A2, L2, L3),
202	subarray_to_list(3, N1, M1, A3, L3, L).
203subarray_to_list(_, _, _, _, L, L).
204