% variant of ECLiPSe's search/6 predicate adapted 
% for tor and SWI-Prolog clpfd.

% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipse-clp.org/license.
% 
% Software distributed under the License is distributed on an "AS IS"
% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
% the License for the specific language governing rights and limitations
% under the License. 
% 
% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
% Portions created by the Initial Developer are
% Copyright (C) 2000 - 2006 Cisco Systems, Inc.  All Rights Reserved.
% 
% Contributor(s): Helmut Simonis, Parc Technologies
%                 Joachim Schimpf and Kish Shen, IC-Parc
% END LICENSE BLOCK
% ----------------------------------------------------------------------
% 
% Generic search routine and search utilities for fd/ic problems
%
% System:	ECLiPSe Constraint Logic Programming System
% Author/s:	Helmut Simonis, Parc Technologies Ltd
%               Joachim Schimpf, IC-Parc
%               Kish Shen, IC-Parc
% Version:	$Id: generic_search.ecl,v 1.4 2009/07/16 09:11:27 jschimpf Exp $
%
% ----------------------------------------------------------------------

% TO-DO: generise to floats for IC, other solvers (e.g. fd_sets)


:- module(generic_search, [search/6]).

:- use_module(library(tor_clpfd)).

:- use_module(library(apply)).
:- use_module(library(lists)).
:- use_module(library(random)).


/***********************************************************************

top level entry

***********************************************************************/

% search(+List:list,
%        ++Arg:integer,
%	++Select:atom,
%	+Choice:atom,
%	++Method:term,
%	?Option:list of options
%	++Module)
% search/6
% most predicates have a Module argument at the end, in order to pass the 
% caller module name to the meta-call predicates
%

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Compatibility
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

get_bounds(X, Min, Max) :-
        fd_inf(X, Min),
        fd_sup(X, Max).

get_compact_domain_as_list(Var,List) :-
  fd_dom(Var,Domain),
  domain_to_list(Domain,List,[]).

get_compact_domain_rep(Var,Rep) :-
  get_compact_domain_as_list(Var,Rep).

domain_to_list(D1\/D2,List,Tail) :-
  domain_to_list(D1,List,Middle),
  domain_to_list(D2,Middle,Tail).
domain_to_list(Lo..Hi,[Lo..Hi|Tail],Tail).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Search
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

search(Vars,Arg,Select,Choice,Method,Option):-
        Module = user,
	Vars = List,
	integer(Arg),
	callable(Select),
	callable(Choice),
	is_search_method(Method),
	is_list(Option),
	!,
	in_out(Choice,In,Out),
   	option_heuristics(Option,search1(List,Arg,Select,Choice,Method,In,Out,Module),Goal),
        search(Goal).
search(Vars,Arg,Select,Choice,Method,Option):-
        Module = generic_search,
	throw(error(5, search(Vars,Arg,Select,Choice,Method,Option), Module)).

:- meta_predicate option_heuristics(?,0,0).

option_heuristics([],Goal,Goal).
option_heuristics([backtrack(N) | Option], Goal, backtrack_count(N, NGoal)) :-
  option_heuristics(Option,Goal,NGoal).
option_heuristics([nodes(Limit) | Option],Goal,nbs(Limit,NGoal)) :-
  option_heuristics(Option,Goal,NGoal).

% branch on the different search methods
search1(L,Arg,Select,Choice,Heuristic,In,Out,Module) :-
	heuristic_goal(Heuristic,labeling(L,Arg,Select,Choice,In,Out,Module),Goal),
        call(Goal).

:- meta_predicate heuristic_goal(+,0,0).

heuristic_goal(complete,Goal,Goal).
heuristic_goal(bbs(Steps),Goal,bbs(Steps,Goal)).
heuristic_goal(lds(Disc),Goal,dibs(Disc,Goal)).
heuristic_goal(credit(Credit,Steps),Goal,credit(Credit,StepsPartialGoal,Goal)) :-
  heuristic_partial_goal(Steps,StepsPartialGoal).
heuristic_goal(dbs(Level,Steps),Goal,dbs(Level,StepsPartialGoal,Goal)) :-
  heuristic_partial_goal(Steps,StepsPartialGoal).

heuristic_partial_goal(bbs(M),bbs(M)).
heuristic_partial_goal(lds(M),dibs(M)).

is_search_method(complete) :- !.
is_search_method(bbs(N)) :- integer(N), !.
is_search_method(credit(N,M)) :- integer(N), integer(M), !.
is_search_method(credit(N,bbs(M))) :- integer(N), integer(M), !.
is_search_method(credit(N,lds(M))) :- integer(N), integer(M), !.
is_search_method(lds(N)) :- integer(N), !.
is_search_method(dbs(N,M)) :- integer(N), integer(M), !.
is_search_method(dbs(N,bbs(M))) :- integer(N), integer(M), !.
is_search_method(dbs(N,lds(M))) :- integer(N), integer(M), !.
/***********************************************************************

different search methods

***********************************************************************/


% labeling(+List:list,
%           ++Arg:integer,
%	   ++Select:atom,
%	   +Choice:atom or p/2,
%	   ?In,
%	   ?Out,
%	   ++Module:atom)
%
%:-mode labeling(+,++,++,+,?,?,?,++,++).
labeling(L,Arg,Select,Choice,In,Out,Module):-
	labeling1(L,Arg,Select,Choice,In,Out,Module).


%:-mode labeling1(+,++,++,+,?,?,?,++,++).
labeling1([],_,_,_,In,In,_Module).
labeling1([H|T],Arg,Select,Choice,In,Out,Module):-
	delete(X,[H|T],R,Arg,Select,Module),
	choose(X,Arg,Choice,In,In1,Module),
	labeling1(R,Arg,Select,Choice,In1,Out,Module).

/***********************************************************************

value choice

***********************************************************************/

% choose(?X,++Arg:integer,++Method:atom,?In,?Out,++Module:atom)
% this predicate chooses a value for the selected term
% this choice is non-deterministic
% for the user defined case, the whole selected term is passed so that
% the user-predicate can assign more than one argument inside
%
%:-mode choose(?,++,++,?,?,++).
choose(X,N,indomain,_In, _Out, _Module):-
	!,
	access(X,N,Var),
	indomain(Var).
choose(X,N,Type,_In, _Out, _Module):-
	translate_indomain_atom(Type, IndomainType),
	!,
	access(X,N,Var),
	indomain(Var,IndomainType).

% TODO: user-defined methods.
% choose(X,_Arg,Method,_In,_Out,Module):- % this is called for a user-defined method
% 	atom(Method),
% 	!,
% 	Call =.. [Method,X],
% 	call(Call)@Module. % may be non-deterministic
% choose(X,_Arg,Method,In,Out,Module):- % this is called for a user-defined method
% 	functor(Method,F,2),
% 	Call =.. [F,X,In,Out],
% 	call(Call)@Module. % may be non-deterministic


/************************************************************

utilities

************************************************************/

% Translate search/6's indomain choice atoms to those used by indomain/2
translate_indomain_atom(indomain, enum).
translate_indomain_atom(indomain_min, min).
translate_indomain_atom(indomain_max, max).
translate_indomain_atom(outdomain_min, reverse_min).	% Zinc
translate_indomain_atom(outdomain_max, reverse_max).	% Zinc
translate_indomain_atom(indomain_reverse_min, reverse_min).
translate_indomain_atom(indomain_reverse_max, reverse_max).
translate_indomain_atom(indomain_middle, middle).
translate_indomain_atom(indomain_median, median).
translate_indomain_atom(indomain_split, split).
translate_indomain_atom(indomain_reverse_split, reverse_split).
translate_indomain_atom(indomain_interval, interval).
translate_indomain_atom(indomain_random, random).

% access argument N of term X, if N=0, X is returned
%:-mode access(?,++,-).
access(X,0,X) :- !.
access(X,N,Var):-
	N > 0,
	arg(N,X,Var).

% Initialize the accumulator variable for the search choice
% this is only used if Choose is a functor of arity 2
%:-mode in_out(?,-,-).
in_out(T,In,Out):-
	functor(T,_,2),
	!,
	arg(1,T,In),
	arg(2,T,Out).
in_out(_T,-,-).

/*
value_range([H|T],Arg,Range):-
	access(H,Arg,H1),
	value_range(T,H1,Msg),
	dom(Msg,Range).

value_range([],X,X).
value_range([H|T],Old,End):-
	access(H,Arg,H1),
	dvar_msg(H1,Old,New),
	value_range(T,New,End).

*/

/***********************************************************************

variable selection 

***********************************************************************/

%:-export(delete/5).
%:-tool(delete/5, delete/6).

% delete(-X,+List:non_empty_list,-R:list,++Arg:integer,++Select:atom,
%            ++Module:atom)
% choose one entry in the list based on a heuristic
% this is a deterministic selection
% a special case for input order to speed up the selection in that case
%
%:-mode delete(-,+,-,++,++,++).
delete(H,List,T,_Arg,input_order,_Module):-
	!, List = [H|T].
delete(X,List,R,Arg,Select,Module):-
	List = [H|T],
	find_criteria(H,Arg,Select,Crit,Module),
	( var(Crit) ->
	    X=H, R=T	% we can't do any better!
	;
	    find_best_and_rest(T,List,Crit,X,R,Arg,Select,Module)
	).


% find_best_and_rest(
%	+List:list,		the unscanned tail
%	+BestSoFar:list,	the tail starting with the current best
%	?Crit: variable, number or crit(Crit,Crit),
%	-Best, -Rest_best:list,	the result
%	++Arg:integer,++Select:atom,++Module:atom)
%
%:- mode find_best_and_rest(+,+,?,-,-,++,++,++).
find_best_and_rest([], BestSoFar, _OldCrit, BestVar, Rest, _Arg, _Select, _Module) :- !,
	BestSoFar = [BestVar|Rest].
find_best_and_rest(List, BestSoFar, CritOld, BestVar, Rest, Arg, Select, Module) :-
	List = [Var|Vars],
	find_criteria(Var, Arg, Select, CritNew, Module),
	( CritNew @>= CritOld ->	% no better than the old one, continue
	    find_best_and_rest(Vars, BestSoFar, CritOld, BestVar, Rest, Arg, Select, Module)
	; nonvar(CritNew) ->		% found a better one, continue
	    % copy the chunk between old and new best
	    copy_until_elem(BestSoFar, Var, Rest, Rest0),
	    find_best_and_rest(Vars, List, CritNew, BestVar, Rest0, Arg, Select, Module)
	;
	    % we can't do any better, stop
	    BestVar = Var,
	    % copy the chunk between old and new best, and append the unscanned rest
	    copy_until_elem(BestSoFar, Var, Rest, Vars)
	).


% find_criteria(?Term,++Arg:integer,++Select:atom,
%		-Crit:integer or crit(integer,integer),
%               ++Module:atom)
%
% find a heuristic value from a term
%:-mode find_criteria(?,++,++,-,++).
find_criteria(Term,0,Select,Crit,Module):-
	!,
	find_value(Term,Select,Crit,Module).
find_criteria(Term,Arg,Select,Crit,Module):-
	arg(Arg,Term,X),
	find_value(X,Select,Crit,Module).

% find_value(?X:dvarint,++Select:atom,
%	     -Crit:integer or crit(integer,integer),
%            ++Module:atom)
%
% Find a heuristic value from a domain variable: the smaller, the better.
% Values will be compared using @<, so be aware of standard term ordering!
% If the Criterion remains uninstantiated, this indicates an optimal value,
% which will be picked without looking any further down the list.
%:-mode find_value(?,++,-,++).
find_value(X,first_fail,Size,_Module):-
	!,
	( nonvar(X) ->
	    true	% pick constants first and commit
	;
	    fd_size(X,Size0),
	    ( integer(Size0) -> Size=Size0 ; Size=inf )	% 99 @< 'inf'
	).
find_value(X,anti_first_fail,Number,_Module):-
	!,
	fd_size(X,Size),				% can be 1.0Inf
	Number is -Size.				% -1.0Inf @< -99
find_value(X,smallest,Min,_Module):-
	!,
	fd_inf(X,Min).
find_value(X,largest,Number,_Module):-
	!,
	fd_sup(X,Max),
	Number is -Max.
find_value(X,occurence,Number,Module):-	% mis-spelt in first version
	!,
	find_value(X,occurrence,Number,Module).
/*
find_value(X,occurrence,Number,_Module):-
	!,
	( nonvar(X) ->
	    true	% pick constants first and commit
	;
	    get_constraints_number(X,Nr), % this is very heavy
	    Number is -Nr
	).
find_value(X,max_regret,Number,_Module):-
	!,
	( nonvar(X) ->
	    true	% pick constants first and commit
	;
	    get_compact_domain_rep(X,L),
	    nth_value(L,2,V),
	    fd_inf(X,Min),
	    Number is -(V-Min)
	).
*/
find_value(X,most_constrained,Crit,Module):-
	!,
	( nonvar(X) ->
	    true	% pick constants first and commit
	;
	    Crit = crit(Size,Number),
	    find_value(X,first_fail,Size,Module),
	    find_value(X,occurrence,Number,Module)
	).
% TODO: user routine
% find_value(X,User_method,Value,Module):-
% 	Call =..[User_method,X,Value],
% 	once(Call)@Module.	% do not allow backtracking in user routine


% Copy list until first occurrence of K and return as difference list
%:- mode copy_until_elem(+,?,?,?).
copy_until_elem([X|Xs], K, Ys, Ys0) :-
	( X==K ->
	    Ys = Ys0
	;
	    Ys = [X|Ys1],
	    copy_until_elem(Xs, K, Ys1, Ys0)
	).


/****************************************************

some indomain variants

****************************************************/

:-export(indomain/2).

% indomain(?X:dvarint,++Type:atomic)
% Type is either one of min, max, middle or an integer
% these indomain versions remove the previous value on backtracking
%:-mode indomain(?,++).
indomain(X,Type):- indomain1(X,Type).

%:-mode indomain1(?,++).
indomain1(X,enum):-
	indomain(X).
indomain1(X,min):-
	fd_inf(X,Min),
	indomain_min(X,Min).
indomain1(X,max):-
	fd_sup(X,Max),
	indomain_max(X,Max).
indomain1(X,reverse_min):-
	fd_inf(X,Min),
	outdomain_min(X,Min).
indomain1(X,reverse_max):-
	fd_sup(X,Max),
	outdomain_max(X,Max).
indomain1(X,middle):-
	select_initial_value_middle(X,Value),
	indomain1(X,Value).
indomain1(X,median):-
	select_initial_value_median(X,Value),
	indomain1(X,Value).
indomain1(X,split):-
	indomain_split(X).
indomain1(X,reverse_split):-
	indomain_reverse_split(X).
indomain1(X,interval):-
	indomain_interval(X).
indomain1(X,random):-
	indomain_random(X).
indomain1(X,Value):-
	integer(Value),
	get_bounds(X,Min,Max),
	( Value =< Min ->
	    % if the starting value is too small, use indomain_min
	    indomain_min(X,Min)
	; Value >= Max ->
	    % if the starting value is too large, use indomain_max
	    indomain_max(X,Max)
	;
	    % enumerate from a starting value inside the domain
	    % is this enough in all cases ??
	    Range is 2*max(Max-Value,Value-Min)+1,
	    indomain_from(X,Value,1,Range)
	).

    % translate middle into a starting value
select_initial_value_middle(X,Value) :-
	get_bounds(X,Min,Max),
	Value is (Min+Max)//2. % HS: remember to use integer division

    % translate median into a starting value
select_initial_value_median(X,Value) :-
	fd_size(X,Size),
	Index is 1+Size//2,
	get_compact_domain_rep(X, L),
	nth_value(L,Index,Value).

% indomain_from(?X:dvar, ++Value:integer, ++Inc:integer, ++Range:integer)
% the choice consists in either taking the proposed value or in excluding it
% and choosing another one
% the next value is always the old value plus the increment
% the next increment is one bigger than the previous, but of opposite sign
% 1, -2, 3, -4, 5, -6, 7 ...
% if the increment becomes too large, you can stop
%:-mode indomain_from(?,++,++,++).
indomain_from(X,Value,Inc,Range):-
	( X #= Value
 	tor
	  X #\= Value,
	  Value1 is Value+Inc,
	  Inc1 is -sign(Inc)*(abs(Inc)+1),
	  Range >= abs(Inc1),
	  indomain_from(X,Value1,Inc1,Range)
	).

% indomain_min(?X:dvar, ++Value:integer)
% the choice consists in either taking the proposed value or in excluding it
% and choosing another one
%:-mode indomain_min(?,++).
indomain_min(X,Min) :-
  ( 	X #= Min
  tor
	X #> Min,
	fd_inf(X,New),
	indomain_min(X,New)
  ).

%:-mode outdomain_min(?,++).
outdomain_min(X,Min) :-
  ( X #> Min,
	fd_inf(X,New),
	outdomain_min(X,New)
  tor
	X #= Min
  ).
    


% indomain_max(?X:dvar, ++Value:integer)
% the choice consists in either taking the proposed value or in excluding it
% and choosing another one
%:-mode indomain_max(?,++).
indomain_max(X,Max) :-
  ( 	X #= Max
  tor
	X #< Max,
	fd_sup(X,New),
	indomain_max(X,New)
  ).

%:-mode outdomain_max(?,++).
outdomain_max(X,Max):-
	( X #< Max,
	  fd_sup(X,New),
	  outdomain_max(X,New)
        tor
	  X #= Max
        ).

% split the domain into intervals until only an integer value is left
%:-mode indomain_split(?).
indomain_split(X):-
	integer(X),
	!.
indomain_split(X):-
	get_bounds(X,Min,Max),
	Middle is (Min+Max) div 2,
	(
	    X #=< Middle
	tor
	    X #> Middle
	),
	indomain_split(X).

%:-mode indomain_reverse_split(?).
indomain_reverse_split(X):-
	integer(X),
	!.
indomain_reverse_split(X):-
	get_bounds(X,Min,Max),
	Middle is (Min+Max) div 2,
	(
	    X #> Middle
	tor
	    X #=< Middle
	),
	indomain_reverse_split(X).

% assign values by first choosing one interval from the domain and
% then assigning values from the middle of that domain
%:-mode indomain_interval(?).
indomain_interval(X):-
	get_compact_domain_as_list(X,L),
	fix_interval(X,L).

%:-mode fix_interval(?,++).
fix_interval(X,[A|_R]):-
  ( integer(A) ->
      (   X #= A
      tor
	  X #\= A,
	  fix_interval(X,R)
      )
  ; A = [_A..B|R] ->
      ( X #=< B,
	indomain(X,split)   % there are many alternatives here
      tor
	X #> B,
	fix_interval(X,R)
      )
  ).

% choose values from the domain at random; on backtracking, the previous value
% is removed, so that it can be used for a complete enumeration
%:-mode indomain_random(?).
indomain_random(X):-
	fd_size(X,Size),
	random(V),
	Index is 1+ (V mod Size),
	get_compact_domain_rep(X,L),
	nth_value(L,Index,Try),
	indomain_random(X,Try).

%:-mode indomain_random(?,++).
indomain_random(X,Try) :-
  (   X #= Try 
  tor
      X #\= Try,
      indomain_random(X)
  ).


/****************************************************

other useful stuff

****************************************************/

:-export(nth_value/3).

nth_value(V, 1, V) :-
	integer(V).
nth_value(I, N, V) :-
	I = _.._,
	nth_value1(I, [], N, V).
nth_value([I | R], N, V) :-
	nth_value1(I, R, N, V).

nth_value1(A..B, R, N, V) :-
	A1 is A + N - 1,
	N1 is A1 - B,
	( N1 > 0 ->
	    nth_value(R, N1, V)
	;
	    A1 >= A,
	    V = A1
	).
nth_value1(A, R, N, V) :-
	atomic(A),
	nth_value2(A, R, N, V).

nth_value2(A, _R, 1, V) :-
	!,
	V = A.
nth_value2(_A, R, N, V) :-
	N1 is N - 1,
	nth_value(R, N1, V).