Did you know ... Search Documentation:
Pack modeling -- prolog/arrays.pl
PublicShow source
author
- Francois Fages
version
- 1.1.0

This module provides an efficient implementation of multidimensional arrays by terms of array terms.

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

array_lists/2 makes conversions between an array and a list (of lists), which can be used to initialize an array to a list of values.

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

This module includes module quantifiers.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[Indices] notation defined here with multifile shorthand/3 predicate of library(quantifiers), can be used in quantifiers and let/2 expressions and library(clp) constraints.

Array cells can also be modified by destructive assignment, backtrackable or not.

?- 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(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_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(+Term)
tests whether a given term is an array without checking dimension consistency.
 array(?Array, ?DimensionList)
Array is an array of dimension DimensionList. Either creates an array of given dimensions or returns the dimensions of a given array. Each dimension is an integer greater or equal to 1.
 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.
 cell(+ArrayIndices, ?Cell)
Just a shorthand for cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]
 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.
 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.
 set_cell(+Array, +Indices, ?Term)
backtrackable assignment of Term to either simple array cell or all subarray cells at given indices.
 set_cell(+ArrayIndices, ?Cell)
Just a shorthand for set_cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]
 nb_set_cell(+Array, +Indices, ?Term)
backtrackable assignment of Term to either simple array cell or all subarray cells at given indices.
 nb_set_cell(+ArrayIndices, ?Cell)
Just a shorthand for nb_set_cell(Array, Indices, Cell) for ArrayIndices of the shorthand/3 form Array[Indices]

Undocumented predicates

The following predicates are exported, but not or incorrectly documented.

 for_all(Arg1, Arg2)
 exists(Arg1, Arg2)
 let(Arg1, Arg2)
 list_of(Arg1, Arg2)
 apply_list(Arg1, Arg2)
 call_list(Arg1, Arg2)
 call_list(Arg1, Arg2, Arg3)
 call_list(Arg1, Arg2, Arg3, Arg4)
 call_list(Arg1, Arg2, Arg3, Arg4, Arg5)
 call_list(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)
 expand(Arg1, Arg2)
 expand(Arg1)
 evaluate(Arg1, Arg2)
 indent_term(Arg1)