Arrays in Prolog and OOP

As I mentioned already in the post https://myriad.website/arrays-in-prolog/, because Prolog is immutable it present challenges for implementing fast Arrays, but it is not impossible. The raw implementations in the post is good and all, but we can do better by encapsulating and systematizing the code.
if you were wondering, yes Prolog can do OOP via the Logtalk project.

The reasons for this tutorial are many-fold … first and foremost we would learn to do some OOP in Prolog. It is surprising how intricate and interesting the OOP was integrated and adapted to such a quaint language.
Second making the Array class/object allow us to encapsulate and extend 1D,2D arrays and array-views.

Recap

From the post you’ve already learned that the best compromise is to use a Term/Structure to store the array, because it allows direct access to the elements i.e.it is faster than lists. The manipulation of data is done via the combo arg/setarg, like this :

?- A=array(1,2,3,4,5),setarg(3,A,abc),arg(3,A,El3).
A = array(1, 2, abc, 4, 5),
El3 = abc.

Did you catch it ? It is not all drawbacks … we can set “array”-elements to any value, even another structure :

?- A=array(1,2,3,4,5),setarg(3,A,color(red)),arg(3,A,El3).
A = array(1, 2, color(red), 4, 5),
El3 = color(red).

… now let talk about

Logtalk

This is a project by Paulo Moura that implement OOP with support for many Prolog dialects.

LogTalk support all kinds of OOP schemes. By composing the three basic building blocks Protocols, Categories and Objects you can build Prototype and/or Class based OOP, Interface and/or Implementation, inheritance, sub-classing, mixins/ductyping, aspects ….. and so on

Because Objects need to hold data, mainstream languages normally use hash/dict like structure for this purpose.

As I understand it Logtalk have two ways to store the object data/attributes :

  • the first kind uses the Prolog DB as a storage, thus by calling assert/retract you can modify the content of those attributes.
  • the second kind is called Parametric, where the attributes are stored in a compound term. This is the one we will use.

Categories

Very often you have a piece of code you want to reuse in multiple objects/classes. It is better to write it just once and then import in the every class definition you need, right ? . This is what categories are for.

In OOP lingo they are known as mixins.

Here is an example of Parametric category :

:- category(attributes(_SELF_)).

	:- public(info/1). %%access the info term
	info(Value) :-arg(1,_SELF_,Value).

:- end_category.

As a I mentioned a Parametric object/category holds data in a compound term.

In the example above : attributes(_SELF_), where attributes() is the name of the category and this term encapsulates the _SELF_ variable which holds the object data in another term. The variable can have any name, but it needs to have leading and trailing underscore.
You then use this variable in the code to access the category/object data.

Next you import the category into an object so you can call the methods.

:- object(a1d(_Ary_), imports(attributes(_Ary_))).

  :- public(size/1).
  size(S) :- ::info_get(1,S).

:- end_object

Here _Ary_ is the “substitution/alias” for _SELF_.

That was just quick intro for the purposes of this article for more details check the LogTalk docs.
Lets now continue with the design decisions of how to implement it.

Design

Because in the current project I want to support different types of objects I will separate the data and the metadata in their own terms, like this struct(info(…),data(…)):

?- O=array(info(5),data(1,2,3,4,5)),O=array(_,A),setarg(3,A,7),arg(3,A,El3).
O = array(info(5), data(1, 2, 7, 4, 5)),
A = data(1, 2, 7, 4, 5),
El3 = 7.

The design ended up tailor made for a tutorial ;), because it shows different modes of composition.

I ended up with 3 classes : 1D array, 2D array, 2D-view and 2 categories : one to handle the structure that holds the data and second to add support for multi-index and/or multi-value for the 2D array/view.

All three classes use the struct-category : 1D array and 2D-view directly importing it and the 2D array indirectly, because it inherits the 1D class.

The two 2D classes import the category “multi” directly.

The Code

Note: you call methods by using double colon :: i.e. sending a message to the object

First let see how we can use the classes, by instantiating objects and manipulating data :

main(A1,A2,V) :-

	%% create 1D array, second arg is filler value
	a1d(A1)::new(10,0),
	%% set some elements
	a1d(A1)::(set(1,1),set([2,3,4],[2,3,4]), set([5,6], abc)),
        %% print the array size
	a1d(A1)::size(S1), say("1D: size : ~w", [S1]), 
	%% print the array
        say("array : "), a1d(A1)::show,
	writeln(""),

	a2d(A2)::new(9,9,0), %% create 2D array 
	a2d(A2)::size(S2), say("2D: size : ~w", [S2]), 
	%% set elements
	a2d(A2)::(set(4,4,5), set([[2,2],[3,3]],[2,3]) ), 
	say("9x9 array : "), a2d(A2)::show,
	writeln(""),
	
	%% create view and do operations
	view(V)::(new(A2,2,2,4,4),set(1,2,1),set([[2,1],[4,2]],9)),
	say("4x4 view : "), view(V)::show.

this will print the following ..

?- main(A1,A2,V).
1D: size : 10
array : 
s(1,2,3,4,abc,abc,0,0,0,0)

2D: size : 81
set 4,4 : 5
set 2,2 : 2
set 3,3 : 3
9x9 array : 
[0,0,0,0,0,0,0,0,0]
[0,2,0,0,0,0,0,0,0]
[0,0,3,0,0,0,0,0,0]
[0,0,0,5,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,0]

view-set 1,2 : 1
set 2,3 : 1
view-set 2,1 : 9
set 3,2 : 9
view-set 4,2 : 9
set 5,3 : 9
4x4 view : 
2|1|0|0|
9|3|0|0|
0|0|5|0|
0|9|0|0|

… and here is the annotated code ..

  • First I define some helper Functions : say, split …
  • Then I define a Category to manage the data structure : struct(…..)
  • Next a Category for handling multi-index, multi-value getters and setters : multi
  • And finally the three classes
%% print shortcut
say(Lst) :- is_list(Lst), writeln(Lst).
say(Compound) :- compound(Compound), writeln(Compound).
say(S)   :- say(S,[]).
say(S,P) :- string_concat(S, '~n', S1), format(S1,P).
debug(S,P) :- say(S,P).

%% split list in N-sized pieces
split([],_,[]) :- !.
split(Lst, N, [FirstN|Res]) :- length(FirstN, N), append(FirstN, Rest, Lst), !, split(Rest, N, Res).
split(Lst, N, [Lst]) :- length(Lst, Len), Len < N.

%% prints List-of-Lists
row(L) :- write(L), nl.
display_LoL([]).
display_LoL([H|T]) :- row(H), display_LoL(T).


%% Expected structure : term(info(...), data(...)) 
:- category(struct(_SELF_)).

	:- public(info/1). %%access the info term
	info(Value) :-arg(1,_SELF_,Value).

	:- public(info_get/2). %% get elem by position
	info_get(Ix,Value) :- arg(1,_SELF_,Info), arg(Ix,Info,Value).

	:- public(info_set/2). %% set elem by position
	info_set(Ix,Value) :- arg(1,_SELF_,Info), setarg(Ix,Info,Value).

	:- public(data/1). %%access the data storage term
	data(Value) :-arg(2,_SELF_,Value).
	
	:- public(data_get/2).
	data_get(Ix,Value) :- arg(2,_SELF_,Data), arg(Ix,Data,Value).

	:- public(data_set/2).
	data_set(Ix,Value) :- arg(2,_SELF_,Data), setarg(Ix,Data,Value).

:- end_category.

%% multi-index and multi-value access
:- category(multi).

	:- public(get/2).
	get([],_).
	%% multi-index single value
	get([[Row, Col]|RCs], Value) :- \+ is_list(Value), ::get(Row, Col, Value), get(RCs, Value).
	%% multi-index multiple values
	get([[Row, Col]|RCs], [V|Vs]) :- ::get(Row, Col, V), get(RCs, Vs).

	:- public(set/2).
	set([],_). %% multi-ix/value set	
	set([[Row, Col]|RCs], Value) :- \+ is_list(Value), ::set(Row, Col, Value), set(RCs, Value).
	set([[Row, Col]|RCs], [V|Vs]) :- ::set(Row, Col, V), set(RCs, Vs).

:- end_category.

%% 1D array
:- object(a1d(_Ary_), imports(struct(_Ary_))).

	:- public(new/3). %% with filler-val and exact info-struct
	new(Size, Filler, Info) :-
		functor(Ary, s, Size),%%set structure and size
		forall(%%fill the array
			arg(Arg, Ary, _),
			nb_setarg(Arg, Ary, Filler)
		),
		_Ary_ = a(Info,Ary).

	:- public(new/2). %% with default struct
	new(Size, Filler) :- new(Size,Filler,i(Size)).

	:- public(new/1). %% with default filler
	new(Size) :- new(Size,0,i(Size)).

	:- public(size/1).
	size(S) :- ::info_get(1,S).

	:- public([get/2, get/3]). %% use integer() as a guard
	get(Ix, Value) :- integer(Ix), ::data_get(Ix,Value).
	get([],_). %% no more ixs
	%% multi ix, single value
	get([Ix|Ixs], V) :- integer(Ix), \+ is_list(V), ::data_get(Ix,V), get(Ixs,V).
	%% multi ix, multiple values
	get([Ix|Ixs], [V|Vs]) :- integer(Ix), ::data_get(Ix,V), get(Ixs,Vs).

	:- public([set/2, set/3]).
	set(Ix, Value) :- integer(Ix), ::data_set(Ix,Value).
	set([],_).
	set([Ix|Ixs], V) :- integer(Ix), \+ is_list(V), ::data_set(Ix,V), set(Ixs,V).
	set([Ix|Ixs], [V|Vs]) :- integer(Ix), ::data_set(Ix,V), set(Ixs,Vs).

	:- public(show/0).
	show :- ::data(D), writeln(D).

:- end_object.


%% 2D array, inherits 1D array and applies the category 'multi'
:- object(a2d(_Ary_), imports(multi), extends(a1d(_Ary_))).

	:- public(new/3).%% call the super class constructor with different info-struct
	new(Rows, Cols, Filler) :- Size is Rows * Cols, ^^new(Size,Filler,i(Rows,Cols)).
	:- public(new/2).
	new(Rows, Cols) :- new(Rows,Cols,0).

	%% array info
	:- public(rows/1).
	rows(R) :- ::info_get(1,R).
	:- public(cols/1).
	cols(C) :- ::info_get(2,C).
	:- public(size/1).
	size(S) :- ::info_get(1,R), ::info_get(2,C), S is R * C.
	:- public(shape/1).
	shape([R|C]) :- ::info_get(1,R), ::info_get(2,C).


	:- public(get/3). 
	get(Row, Col, Value) :- 
		integer(Row),integer(Col),
		::info_get(2,C),Pos is (Row-1) * C + Col,::data_get(Pos, Value).
	%% get/2 imported from category

	:- public(set/3).
	set(Row, Col, Value) :- 
		integer(Row),integer(Col),
		::info_get(2,C), Pos is (Row-1) * C + Col, 
		{debug("set ~w,~w : ~w", [Row,Col,Value])},
		::data_set(Pos, Value).
	%% set/2 imported from category

	:- public(tolst/1).%%convert the data term to List
	tolst(Lst) :- ::data(Ary), Ary =.. [ _ | Lst].

	:- public(show/0).
	show :- 
		::info_get(2,C), ::tolst(Lst), {split(Lst,C,LoL), display_LoL(LoL)}.

:- end_object.


%% Partial view of the 2D array, apply both categories
:- object(view(_View_), imports([ multi, struct(_View_) ])).

	:- public(new/5).
	new(Ary,X,Y,W,H) :- _View_ = v(i(X-1,Y-1,W,H),Ary). 

	:- public(get/3).
	get(A,B,V) :- 
		integer(A), integer(B), ::info(I), I = i(X,Y,W,H),
		R is A+X, C is B+Y, R =< X + H, C =< Y + W,
		::data(Ary), a2d(Ary)::get(R,C,V).
	%% get/2 imported from category

	:- public(set/3).
	set(A,B,V) :- 
		%% checks & info extraction
		integer(A), integer(B), ::info(I), I = i(X,Y,W,H),
		%% calc coords
		R is A+X, C is B+Y, R =< X + H, C =< Y + W,
		{debug("view-set ~w,~w : ~w", [A,B,V])},
		::data(Ary), a2d(Ary)::set(R,C,V).
	%% set/2 imported from category

	:- public(show/0).
	show :- 
		::info_get(3,W), ::info_get(4,H), 
		forall( between(1,H,A),
			forall( between(1,W,B), 
				(::get(A,B,V), write(V), write("|"), (B == W -> nl; true))
			)
		).

:- end_object.