1/*
    2  arrays.pl
    3  
    4  @author Francois Fages
    5  @email Francois.Fages@inria.fr
    6  @license LGPL-2
    7
    8  @version 1.1.3
    9
   10  
   11  Multidimensional arrays with Array[Indices] functional notation and list conversions.
   12
   13  The indices are evaluated and can be expressions containing shorthands.
   14
   15*/
   16
   17:- module(
   18	  arrays,
   19	  [
   20	   array/1,
   21	   array/2,
   22	   
   23	   cell/3,
   24	   cell/2,
   25	   op(100, yf, []),
   26	   
   27	   array_lists/2,
   28	   array_list/2,
   29	   
   30	   set_cell/3,
   31	   set_cell/2,
   32	   nb_set_cell/3,
   33	   nb_set_cell/2
   34	   ]
   35	 ).

multidimensional arrays with conversions to lists and Array[Indices] functional notation.

author
- Francois Fages
version
- 1.1.3

This module provides an implementation of multidimensional arrays by terms.

The array indices are integers starting at 1 and the dimension of an array is a list of integers.

array_list/2 (resp. array_lists/2) makes conversions between an array and a list (resp. of lists for multi-dimensional arrays), which can be used to initialize an array to a list of values.

?- array_lists(A, [[1, 2, 3], [4, 5, 6]]), array(A, Dim).
A = array(array(1, 2, 3), array(4, 5, 6)),
Dim = [2, 3].

Array cells are accessed by unification with predicate cell/3.

This module includes module comprehension.pl for bounded quantification and is compatible with attributed variables, clpfd and clpr libraries for creating arrays of constrained variables, and posting constraints on subscripted variables.

Array cells can also be modified by destructive assignment, backtrackable or not, with set_cell/3 and nb_set_cell/3.

?- array(A, [3]), cell(A, [2], v).
A = array(_, v, _).

?- array(A, [2, 3]), cell(A, [2,2], 3).
A = array(array(_, _, _), array(_, 3, _)).

?- array(A, [2, 3]), cell(A, [2], X).
A = array(array(_, _, _), array(_A, _B, _C)),
X = array(_A, _B, _C).

?- array_list(A, [2,3,4]), let([I=A[1],V=A[I]], writeln(a(I,V))).
a(2,3)
A = array(2, 3, 4).
  
?- array(A, [2, 3]), (set_cell(A, [1], 9) ; nb_set_cell(A, [2], 5); set_cell(A, [2,2],8)).
A = array(array(9, 9, 9), array(_, _, _)) ;
A = array(array(_, _, _), array(5, 5, 5)) ;
A = array(array(_, _, _), array(5, 8, 5)).

Array[Indices], or cell(Array, Indices) functional notations defined here using multifile shorthand/3 predicate of library(comprehension) are automatically expanded in "in" and "where" conditions of comprehension metapredicates and in constraints of library(clp).

?- array(A, [5]), for_all([I in 1..5], A[I] #= I).
A = array(1, 2, 3, 4, 5).

*/

   92%:- catch(reexport(library(comprehension)), _, (throw(error(pack_comprehension_is_not_installed)), fail)).
   93:- reexport(library(comprehension)).   94
   95
   96				% ARRAY CREATION
 array(+Term)
tests whether a given term is an array without checking multidimensional consistency.
  102array(Term):-
  103    compound(Term),
  104    functor(Term, array, _).
 array(?Array, ?DimensionList)
Array is an array of dimension DimensionList. Either creates an array of given dimensions greater or equal to 1, or returns the dimensions of a given array, or enumerates single dimension arrays.
  116array(Array, Dimensions):-
  117    expand(Array, A),
  118    expand(Dimensions, D),
  119    (var(A), (var(D) ; D=[N], var(N))
  120    ->
  121     D=[N],
  122     between(1, inf, N),
  123     functor(A, array, N)
  124    ;
  125     array_rec(A, D)).
  126
  127array_rec(Array, Dimensions):-
  128    (compound(Array)
  129    ->
  130     functor(Array, array, N),
  131     Dimensions=[N|Tail],
  132     for_all(I in 1..N,
  133	     let([Row=Array[I]],
  134		 (arrays:array_rec(Row, Tail) -> true ; Tail=[])))
  135    ;
  136     nonvar(Dimensions),
  137     Dimensions = [N | Tail],
  138     nonvar(N),
  139     functor(Array, array, N),
  140     (Tail=[]
  141     ->
  142      true
  143     ;
  144      for_all(I in 1..N, let([Row=Array[I]],
  145			     (arrays:array_rec(Row, Tail)) -> true; Tail=[])))).
  146
  147
  148				% CELL ACCESS
 cell(+Array, +Indices, ?Cell)
Cell is the Array cell at given Indices (list of indices for a multidimensional array). Throws an error if the indices are out of range. Shorthand expressions in Indices are evaluated.
  157cell(Array, I, _Term):-
  158    must_be(compound, Array),
  159    must_be(nonvar, I),
  160    fail.
  161
  162cell(Array, [Ind | Indices], Term):-
  163    !,
  164    evaluate(Ind, I),
  165    cell(Array, I, Row),
  166    (Indices=[]
  167    ->
  168     Term=Row
  169    ;
  170     cell(Row, Indices, Term)).
  171
  172cell(Array, Expr, Term):-
  173    evaluate(Expr, I),
  174    arg(I, Array, Term).
 cell(+ArrayIndices, ?Cell)
Just a shorthand for cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]
  181cell(ArrayIndices, Cell):-
  182    must_be(nonvar, ArrayIndices),
  183    ArrayIndices=Array[Indices],
  184    cell(Array, Indices, Cell).
  185
  186
  187				% SHORTHAND FUNCTIONAL NOTATION FOR ARRAY ACCESS
  188
  189
  190:- multifile user:shorthand/3.
 shorthand(+Term, +Expanded, +Goal)
Multifile predicate defined here for Array[Indices] and equivalently cell(Array, Indices) functional notations.
  196user:shorthand([](Indices, Array), V, cell(Array, Indices, V)):- !. % pattern matching A[2,3]=B[C] does not work
  197
  198user:shorthand(cell(Array, Indices), V, cell(Array, Indices, V)):- !. % pattern matching A[2,3]=B[C] does not work
  199
  200
  201
  202				% CONVERSIONS BETWEEN ARRAYS AND LISTS
 array_list(?Array, ?List)
List is the flat list of the array cells with lexicographically ordered indices. Either creates the List or a one dimensional Array indexed by integers starting from 1. For a one dimensional array, there is no difference with array_lists/2.
  210array_list(Array, List):-
  211    (
  212     array(Array)
  213    ->
  214     array_to_lists(Array, Lists),
  215     flatten(Lists, List)
  216    ;
  217     Array =.. [array | List]
  218    ).
 array_lists(+Array, ?List)
List is the list (of lists in the case of a multidimensional array) of the array cells with lexicographically ordered indices. Either creates the lists or the array indexed by integers in intervals starting from 1. For a one dimensional array, there is no difference with array_list/2.
  227array_lists(Array, Lists):-
  228    (
  229     array(Array)
  230    ->
  231     array_to_lists(Array, Lists)
  232    ;
  233     lists_to_array(Lists, Array)
  234    ).
  235
  236
  237array_to_lists(Array, List):-
  238    Array =.. [array | Rows],
  239    (
  240     (Rows=[R | _], array(R))
  241    ->
  242     call_list(arrays:array_to_lists, Rows, List)
  243    ;
  244     List=Rows
  245    ).
  246
  247lists_to_array(Lists, Array):-
  248    must_be(list, Lists),
  249    length(Lists, N),
  250    array(Array, [N]),
  251    for_all(I in 1..N,
  252	    exists([AI, LI],
  253		   (cell(Array, I, AI), nth1(I, Lists, LI), (is_list(LI) -> arrays:lists_to_array(LI, AI) ; LI=AI))
  254		  )
  255	   ).
  256
  257
  258
  259
  260
  261				% IMPERATIVE CELL ASSIGNMENT
 set_cell(+Array, +Indices, ?Term)
backtrackable assignment of Term to either simple array cell or all subarray cells at given indices. Shorthand expressions in Indices are evaluated.
  269set_cell(Array, I, _Term):-
  270    must_be(compound, Array),
  271    must_be(nonvar, I),
  272    fail.
  273
  274set_cell(Array, [I | Indices], Term):-
  275    !,
  276    (Indices=[]
  277    ->
  278     set_all_cells(Array, I, Term)
  279    ;
  280     cell(Array, I, Row),
  281     set_cell(Row, Indices, Term)).
  282
  283set_cell(Array, Expr, Term):-
  284    evaluate(Expr, I),
  285    set_all_cells(Array, I, Term).
 set_cell(+ArrayIndices, ?Cell)
Just a shorthand for set_cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]
  291set_cell(ArrayIndices, Cell):-
  292    must_be(nonvar, ArrayIndices),
  293    ArrayIndices=Array[Indices],
  294    set_cell(Array, Indices, Cell).
  295
  296
  297set_all_cells(Array, I, Term):-
  298    arg(I, Array, A),
  299    (compound(A),
  300     functor(A, array, N)
  301    ->
  302     for_all([J in 1..N], arrays:set_all_cells(A, J, Term))    ;     setarg(I, Array, Term)    ).
 nb_set_cell(+Array, +Indices, ?Term)
backtrackable assignment of Term to either simple array cell or all subarray cells at given indices. Shorthand expressions in Indices are evaluated.
  313nb_set_cell(Array, I, _Term):-
  314    must_be(compound, Array),
  315    must_be(nonvar, I),
  316    fail.
  317
  318nb_set_cell(Array, [I | Indices], Term):-
  319    !,
  320    (Indices=[]
  321    ->
  322     nb_set_all_cells(Array, I, Term)
  323    ;
  324     cell(Array, I, Row),
  325     nb_set_cell(Row, Indices, Term)).
  326
  327nb_set_cell(Array, Expr, Term):-
  328    evaluate(Expr, I),
  329    nb_set_all_cells(Array, I, Term).
 nb_set_cell(+ArrayIndices, ?Cell)
Just a shorthand for nb_set_cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]
  335nb_set_cell(ArrayIndices, Cell):-
  336    must_be(nonvar, ArrayIndices),
  337    ArrayIndices=Array[Indices],
  338    nb_set_cell(Array, Indices, Cell).
  339
  340
  341
  342nb_set_all_cells(Array, I, Term):-
  343    arg(I, Array, A),
  344    (compound(A),
  345     functor(A, array, N)
  346    ->
  347     for_all([J