1% variant of ECLiPSe's search/6 predicate adapted 
    2% for tor and SWI-Prolog clpfd.
    3
    4% BEGIN LICENSE BLOCK
    5% Version: CMPL 1.1
    6%
    7% The contents of this file are subject to the Cisco-style Mozilla Public
    8% License Version 1.1 (the "License"); you may not use this file except
    9% in compliance with the License.  You may obtain a copy of the License
   10% at www.eclipse-clp.org/license.
   11% 
   12% Software distributed under the License is distributed on an "AS IS"
   13% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
   14% the License for the specific language governing rights and limitations
   15% under the License. 
   16% 
   17% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
   18% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
   19% Portions created by the Initial Developer are
   20% Copyright (C) 2000 - 2006 Cisco Systems, Inc.  All Rights Reserved.
   21% 
   22% Contributor(s): Helmut Simonis, Parc Technologies
   23%                 Joachim Schimpf and Kish Shen, IC-Parc
   24% END LICENSE BLOCK
   25% ----------------------------------------------------------------------
   26% 
   27% Generic search routine and search utilities for fd/ic problems
   28%
   29% System:	ECLiPSe Constraint Logic Programming System
   30% Author/s:	Helmut Simonis, Parc Technologies Ltd
   31%               Joachim Schimpf, IC-Parc
   32%               Kish Shen, IC-Parc
   33% Version:	$Id: generic_search.ecl,v 1.4 2009/07/16 09:11:27 jschimpf Exp $
   34%
   35% ----------------------------------------------------------------------
   36
   37% TO-DO: generise to floats for IC, other solvers (e.g. fd_sets)
   38
   39
   40:- module(generic_search, [search/6]).   41
   42:- use_module(library(tor_clpfd)).   43
   44:- use_module(library(apply)).   45:- use_module(library(lists)).   46:- use_module(library(random)).   47
   48
   49/***********************************************************************
   50
   51top level entry
   52
   53***********************************************************************/
   54
   55% search(+List:list,
   56%        ++Arg:integer,
   57%	++Select:atom,
   58%	+Choice:atom,
   59%	++Method:term,
   60%	?Option:list of options
   61%	++Module)
   62% search/6
   63% most predicates have a Module argument at the end, in order to pass the 
   64% caller module name to the meta-call predicates
   65%
   66
   67/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   68   Compatibility
   69- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   70
   71get_bounds(X, Min, Max) :-
   72        fd_inf(X, Min),
   73        fd_sup(X, Max).
   74
   75get_compact_domain_as_list(Var,List) :-
   76  fd_dom(Var,Domain),
   77  domain_to_list(Domain,List,[]).
   78
   79get_compact_domain_rep(Var,Rep) :-
   80  get_compact_domain_as_list(Var,Rep).
   81
   82domain_to_list(D1\/D2,List,Tail) :-
   83  domain_to_list(D1,List,Middle),
   84  domain_to_list(D2,Middle,Tail).
   85domain_to_list(Lo..Hi,[Lo..Hi|Tail],Tail).
   86
   87/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   88   Search
   89- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   90
   91search(Vars,Arg,Select,Choice,Method,Option):-
   92        Module = user,
   93	Vars = List,
   94	integer(Arg),
   95	callable(Select),
   96	callable(Choice),
   97	is_search_method(Method),
   98	is_list(Option),
   99	!,
  100	in_out(Choice,In,Out),
  101   	option_heuristics(Option,search1(List,Arg,Select,Choice,Method,In,Out,Module),Goal),
  102        search(Goal).
  103search(Vars,Arg,Select,Choice,Method,Option):-
  104        Module = generic_search,
  105	throw(error(5, search(Vars,Arg,Select,Choice,Method,Option), Module)).
  106
  107:- meta_predicate option_heuristics(?,0,0).  108
  109option_heuristics([],Goal,Goal).
  110option_heuristics([backtrack(N) | Option], Goal, backtrack_count(N, NGoal)) :-
  111  option_heuristics(Option,Goal,NGoal).
  112option_heuristics([nodes(Limit) | Option],Goal,nbs(Limit,NGoal)) :-
  113  option_heuristics(Option,Goal,NGoal).
  114
  115% branch on the different search methods
  116search1(L,Arg,Select,Choice,Heuristic,In,Out,Module) :-
  117	heuristic_goal(Heuristic,labeling(L,Arg,Select,Choice,In,Out,Module),Goal),
  118        call(Goal).
  119
  120:- meta_predicate heuristic_goal(+,0,0).  121
  122heuristic_goal(complete,Goal,Goal).
  123heuristic_goal(bbs(Steps),Goal,bbs(Steps,Goal)).
  124heuristic_goal(lds(Disc),Goal,dibs(Disc,Goal)).
  125heuristic_goal(credit(Credit,Steps),Goal,credit(Credit,StepsPartialGoal,Goal)) :-
  126  heuristic_partial_goal(Steps,StepsPartialGoal).
  127heuristic_goal(dbs(Level,Steps),Goal,dbs(Level,StepsPartialGoal,Goal)) :-
  128  heuristic_partial_goal(Steps,StepsPartialGoal).
  129
  130heuristic_partial_goal(bbs(M),bbs(M)).
  131heuristic_partial_goal(lds(M),dibs(M)).
  132
  133is_search_method(complete) :- !.
  134is_search_method(bbs(N)) :- integer(N), !.
  135is_search_method(credit(N,M)) :- integer(N), integer(M), !.
  136is_search_method(credit(N,bbs(M))) :- integer(N), integer(M), !.
  137is_search_method(credit(N,lds(M))) :- integer(N), integer(M), !.
  138is_search_method(lds(N)) :- integer(N), !.
  139is_search_method(dbs(N,M)) :- integer(N), integer(M), !.
  140is_search_method(dbs(N,bbs(M))) :- integer(N), integer(M), !.
  141is_search_method(dbs(N,lds(M))) :- integer(N), integer(M), !.
  142/***********************************************************************
  143
  144different search methods
  145
  146***********************************************************************/
  147
  148
  149% labeling(+List:list,
  150%           ++Arg:integer,
  151%	   ++Select:atom,
  152%	   +Choice:atom or p/2,
  153%	   ?In,
  154%	   ?Out,
  155%	   ++Module:atom)
  156%
  157%:-mode labeling(+,++,++,+,?,?,?,++,++).
  158labeling(L,Arg,Select,Choice,In,Out,Module):-
  159	labeling1(L,Arg,Select,Choice,In,Out,Module).
  160
  161
  162%:-mode labeling1(+,++,++,+,?,?,?,++,++).
  163labeling1([],_,_,_,In,In,_Module).
  164labeling1([H|T],Arg,Select,Choice,In,Out,Module):-
  165	delete(X,[H|T],R,Arg,Select,Module),
  166	choose(X,Arg,Choice,In,In1,Module),
  167	labeling1(R,Arg,Select,Choice,In1,Out,Module).
  168
  169/***********************************************************************
  170
  171value choice
  172
  173***********************************************************************/
  174
  175% choose(?X,++Arg:integer,++Method:atom,?In,?Out,++Module:atom)
  176% this predicate chooses a value for the selected term
  177% this choice is non-deterministic
  178% for the user defined case, the whole selected term is passed so that
  179% the user-predicate can assign more than one argument inside
  180%
  181%:-mode choose(?,++,++,?,?,++).
  182choose(X,N,indomain,_In, _Out, _Module):-
  183	!,
  184	access(X,N,Var),
  185	indomain(Var).
  186choose(X,N,Type,_In, _Out, _Module):-
  187	translate_indomain_atom(Type, IndomainType),
  188	!,
  189	access(X,N,Var),
  190	indomain(Var,IndomainType).
  191
  192% TODO: user-defined methods.
  193% choose(X,_Arg,Method,_In,_Out,Module):- % this is called for a user-defined method
  194% 	atom(Method),
  195% 	!,
  196% 	Call =.. [Method,X],
  197% 	call(Call)@Module. % may be non-deterministic
  198% choose(X,_Arg,Method,In,Out,Module):- % this is called for a user-defined method
  199% 	functor(Method,F,2),
  200% 	Call =.. [F,X,In,Out],
  201% 	call(Call)@Module. % may be non-deterministic
  202
  203
  204/************************************************************
  205
  206utilities
  207
  208************************************************************/
  209
  210% Translate search/6's indomain choice atoms to those used by indomain/2
  211translate_indomain_atom(indomain, enum).
  212translate_indomain_atom(indomain_min, min).
  213translate_indomain_atom(indomain_max, max).
  214translate_indomain_atom(outdomain_min, reverse_min).	% Zinc
  215translate_indomain_atom(outdomain_max, reverse_max).	% Zinc
  216translate_indomain_atom(indomain_reverse_min, reverse_min).
  217translate_indomain_atom(indomain_reverse_max, reverse_max).
  218translate_indomain_atom(indomain_middle, middle).
  219translate_indomain_atom(indomain_median, median).
  220translate_indomain_atom(indomain_split, split).
  221translate_indomain_atom(indomain_reverse_split, reverse_split).
  222translate_indomain_atom(indomain_interval, interval).
  223translate_indomain_atom(indomain_random, random).
  224
  225% access argument N of term X, if N=0, X is returned
  226%:-mode access(?,++,-).
  227access(X,0,X) :- !.
  228access(X,N,Var):-
  229	N > 0,
  230	arg(N,X,Var).
  231
  232% Initialize the accumulator variable for the search choice
  233% this is only used if Choose is a functor of arity 2
  234%:-mode in_out(?,-,-).
  235in_out(T,In,Out):-
  236	functor(T,_,2),
  237	!,
  238	arg(1,T,In),
  239	arg(2,T,Out).
  240in_out(_T,-,-).
  241
  242/*
  243value_range([H|T],Arg,Range):-
  244	access(H,Arg,H1),
  245	value_range(T,H1,Msg),
  246	dom(Msg,Range).
  247
  248value_range([],X,X).
  249value_range([H|T],Old,End):-
  250	access(H,Arg,H1),
  251	dvar_msg(H1,Old,New),
  252	value_range(T,New,End).
  253
  254*/
  255
  256/***********************************************************************
  257
  258variable selection 
  259
  260***********************************************************************/
  261
  262%:-export(delete/5).
  263%:-tool(delete/5, delete/6).
  264
  265% delete(-X,+List:non_empty_list,-R:list,++Arg:integer,++Select:atom,
  266%            ++Module:atom)
  267% choose one entry in the list based on a heuristic
  268% this is a deterministic selection
  269% a special case for input order to speed up the selection in that case
  270%
  271%:-mode delete(-,+,-,++,++,++).
  272delete(H,List,T,_Arg,input_order,_Module):-
  273	!, List = [H|T].
  274delete(X,List,R,Arg,Select,Module):-
  275	List = [H|T],
  276	find_criteria(H,Arg,Select,Crit,Module),
  277	( var(Crit) ->
  278	    X=H, R=T	% we can't do any better!
  279	;
  280	    find_best_and_rest(T,List,Crit,X,R,Arg,Select,Module)
  281	).
  282
  283
  284% find_best_and_rest(
  285%	+List:list,		the unscanned tail
  286%	+BestSoFar:list,	the tail starting with the current best
  287%	?Crit: variable, number or crit(Crit,Crit),
  288%	-Best, -Rest_best:list,	the result
  289%	++Arg:integer,++Select:atom,++Module:atom)
  290%
  291%:- mode find_best_and_rest(+,+,?,-,-,++,++,++).
  292find_best_and_rest([], BestSoFar, _OldCrit, BestVar, Rest, _Arg, _Select, _Module) :- !,
  293	BestSoFar = [BestVar|Rest].
  294find_best_and_rest(List, BestSoFar, CritOld, BestVar, Rest, Arg, Select, Module) :-
  295	List = [Var|Vars],
  296	find_criteria(Var, Arg, Select, CritNew, Module),
  297	( CritNew @>= CritOld ->	% no better than the old one, continue
  298	    find_best_and_rest(Vars, BestSoFar, CritOld, BestVar, Rest, Arg, Select, Module)
  299	; nonvar(CritNew) ->		% found a better one, continue
  300	    % copy the chunk between old and new best
  301	    copy_until_elem(BestSoFar, Var, Rest, Rest0),
  302	    find_best_and_rest(Vars, List, CritNew, BestVar, Rest0, Arg, Select, Module)
  303	;
  304	    % we can't do any better, stop
  305	    BestVar = Var,
  306	    % copy the chunk between old and new best, and append the unscanned rest
  307	    copy_until_elem(BestSoFar, Var, Rest, Vars)
  308	).
  309
  310
  311% find_criteria(?Term,++Arg:integer,++Select:atom,
  312%		-Crit:integer or crit(integer,integer),
  313%               ++Module:atom)
  314%
  315% find a heuristic value from a term
  316%:-mode find_criteria(?,++,++,-,++).
  317find_criteria(Term,0,Select,Crit,Module):-
  318	!,
  319	find_value(Term,Select,Crit,Module).
  320find_criteria(Term,Arg,Select,Crit,Module):-
  321	arg(Arg,Term,X),
  322	find_value(X,Select,Crit,Module).
  323
  324% find_value(?X:dvarint,++Select:atom,
  325%	     -Crit:integer or crit(integer,integer),
  326%            ++Module:atom)
  327%
  328% Find a heuristic value from a domain variable: the smaller, the better.
  329% Values will be compared using @<, so be aware of standard term ordering!
  330% If the Criterion remains uninstantiated, this indicates an optimal value,
  331% which will be picked without looking any further down the list.
  332%:-mode find_value(?,++,-,++).
  333find_value(X,first_fail,Size,_Module):-
  334	!,
  335	( nonvar(X) ->
  336	    true	% pick constants first and commit
  337	;
  338	    fd_size(X,Size0),
  339	    ( integer(Size0) -> Size=Size0 ; Size=inf )	% 99 @< 'inf'
  340	).
  341find_value(X,anti_first_fail,Number,_Module):-
  342	!,
  343	fd_size(X,Size),				% can be 1.0Inf
  344	Number is -Size.				% -1.0Inf @< -99
  345find_value(X,smallest,Min,_Module):-
  346	!,
  347	fd_inf(X,Min).
  348find_value(X,largest,Number,_Module):-
  349	!,
  350	fd_sup(X,Max),
  351	Number is -Max.
  352find_value(X,occurence,Number,Module):-	% mis-spelt in first version
  353	!,
  354	find_value(X,occurrence,Number,Module).
  355/*
  356find_value(X,occurrence,Number,_Module):-
  357	!,
  358	( nonvar(X) ->
  359	    true	% pick constants first and commit
  360	;
  361	    get_constraints_number(X,Nr), % this is very heavy
  362	    Number is -Nr
  363	).
  364find_value(X,max_regret,Number,_Module):-
  365	!,
  366	( nonvar(X) ->
  367	    true	% pick constants first and commit
  368	;
  369	    get_compact_domain_rep(X,L),
  370	    nth_value(L,2,V),
  371	    fd_inf(X,Min),
  372	    Number is -(V-Min)
  373	).
  374*/
  375find_value(X,most_constrained,Crit,Module):-
  376	!,
  377	( nonvar(X) ->
  378	    true	% pick constants first and commit
  379	;
  380	    Crit = crit(Size,Number),
  381	    find_value(X,first_fail,Size,Module),
  382	    find_value(X,occurrence,Number,Module)
  383	).
  384% TODO: user routine
  385% find_value(X,User_method,Value,Module):-
  386% 	Call =..[User_method,X,Value],
  387% 	once(Call)@Module.	% do not allow backtracking in user routine
  388
  389
  390% Copy list until first occurrence of K and return as difference list
  391%:- mode copy_until_elem(+,?,?,?).
  392copy_until_elem([X|Xs], K, Ys, Ys0) :-
  393	( X==K ->
  394	    Ys = Ys0
  395	;
  396	    Ys = [X|Ys1],
  397	    copy_until_elem(Xs, K, Ys1, Ys0)
  398	).
  399
  400
  401/****************************************************
  402
  403some indomain variants
  404
  405****************************************************/
  406
  407:-export(indomain/2).  408
  409% indomain(?X:dvarint,++Type:atomic)
  410% Type is either one of min, max, middle or an integer
  411% these indomain versions remove the previous value on backtracking
  412%:-mode indomain(?,++).
  413indomain(X,Type):- indomain1(X,Type).
  414
  415%:-mode indomain1(?,++).
  416indomain1(X,enum):-
  417	indomain(X).
  418indomain1(X,min):-
  419	fd_inf(X,Min),
  420	indomain_min(X,Min).
  421indomain1(X,max):-
  422	fd_sup(X,Max),
  423	indomain_max(X,Max).
  424indomain1(X,reverse_min):-
  425	fd_inf(X,Min),
  426	outdomain_min(X,Min).
  427indomain1(X,reverse_max):-
  428	fd_sup(X,Max),
  429	outdomain_max(X,Max).
  430indomain1(X,middle):-
  431	select_initial_value_middle(X,Value),
  432	indomain1(X,Value).
  433indomain1(X,median):-
  434	select_initial_value_median(X,Value),
  435	indomain1(X,Value).
  436indomain1(X,split):-
  437	indomain_split(X).
  438indomain1(X,reverse_split):-
  439	indomain_reverse_split(X).
  440indomain1(X,interval):-
  441	indomain_interval(X).
  442indomain1(X,random):-
  443	indomain_random(X).
  444indomain1(X,Value):-
  445	integer(Value),
  446	get_bounds(X,Min,Max),
  447	( Value =< Min ->
  448	    % if the starting value is too small, use indomain_min
  449	    indomain_min(X,Min)
  450	; Value >= Max ->
  451	    % if the starting value is too large, use indomain_max
  452	    indomain_max(X,Max)
  453	;
  454	    % enumerate from a starting value inside the domain
  455	    % is this enough in all cases ??
  456	    Range is 2*max(Max-Value,Value-Min)+1,
  457	    indomain_from(X,Value,1,Range)
  458	).
  459
  460    % translate middle into a starting value
  461select_initial_value_middle(X,Value) :-
  462	get_bounds(X,Min,Max),
  463	Value is (Min+Max)//2. % HS: remember to use integer division
  464
  465    % translate median into a starting value
  466select_initial_value_median(X,Value) :-
  467	fd_size(X,Size),
  468	Index is 1+Size//2,
  469	get_compact_domain_rep(X, L),
  470	nth_value(L,Index,Value).
  471
  472% indomain_from(?X:dvar, ++Value:integer, ++Inc:integer, ++Range:integer)
  473% the choice consists in either taking the proposed value or in excluding it
  474% and choosing another one
  475% the next value is always the old value plus the increment
  476% the next increment is one bigger than the previous, but of opposite sign
  477% 1, -2, 3, -4, 5, -6, 7 ...
  478% if the increment becomes too large, you can stop
  479%:-mode indomain_from(?,++,++,++).
  480indomain_from(X,Value,Inc,Range):-
  481	( X #= Value
  482 	tor
  483	  X #\= Value,
  484	  Value1 is Value+Inc,
  485	  Inc1 is -sign(Inc)*(abs(Inc)+1),
  486	  Range >= abs(Inc1),
  487	  indomain_from(X,Value1,Inc1,Range)
  488	).
  489
  490% indomain_min(?X:dvar, ++Value:integer)
  491% the choice consists in either taking the proposed value or in excluding it
  492% and choosing another one
  493%:-mode indomain_min(?,++).
  494indomain_min(X,Min) :-
  495  ( 	X #= Min
  496  tor
  497	X #> Min,
  498	fd_inf(X,New),
  499	indomain_min(X,New)
  500  ).
  501
  502%:-mode outdomain_min(?,++).
  503outdomain_min(X,Min) :-
  504  ( X #> Min,
  505	fd_inf(X,New),
  506	outdomain_min(X,New)
  507  tor
  508	X #= Min
  509  ).
  510    
  511
  512
  513% indomain_max(?X:dvar, ++Value:integer)
  514% the choice consists in either taking the proposed value or in excluding it
  515% and choosing another one
  516%:-mode indomain_max(?,++).
  517indomain_max(X,Max) :-
  518  ( 	X #= Max
  519  tor
  520	X #< Max,
  521	fd_sup(X,New),
  522	indomain_max(X,New)
  523  ).
  524
  525%:-mode outdomain_max(?,++).
  526outdomain_max(X,Max):-
  527	( X #< Max,
  528	  fd_sup(X,New),
  529	  outdomain_max(X,New)
  530        tor
  531	  X #= Max
  532        ).
  533
  534% split the domain into intervals until only an integer value is left
  535%:-mode indomain_split(?).
  536indomain_split(X):-
  537	integer(X),
  538	!.
  539indomain_split(X):-
  540	get_bounds(X,Min,Max),
  541	Middle is (Min+Max) div 2,
  542	(
  543	    X #=< Middle
  544	tor
  545	    X #> Middle
  546	),
  547	indomain_split(X).
  548
  549%:-mode indomain_reverse_split(?).
  550indomain_reverse_split(X):-
  551	integer(X),
  552	!.
  553indomain_reverse_split(X):-
  554	get_bounds(X,Min,Max),
  555	Middle is (Min+Max) div 2,
  556	(
  557	    X #> Middle
  558	tor
  559	    X #=< Middle
  560	),
  561	indomain_reverse_split(X).
  562
  563% assign values by first choosing one interval from the domain and
  564% then assigning values from the middle of that domain
  565%:-mode indomain_interval(?).
  566indomain_interval(X):-
  567	get_compact_domain_as_list(X,L),
  568	fix_interval(X,L).
  569
  570%:-mode fix_interval(?,++).
  571fix_interval(X,[A|_R]):-
  572  ( integer(A) ->
  573      (   X #= A
  574      tor
  575	  X #\= A,
  576	  fix_interval(X,R)
  577      )
  578  ; A = [_A..B|R] ->
  579      ( X #=< B,
  580	indomain(X,split)   % there are many alternatives here
  581      tor
  582	X #> B,
  583	fix_interval(X,R)
  584      )
  585  ).
  586
  587% choose values from the domain at random; on backtracking, the previous value
  588% is removed, so that it can be used for a complete enumeration
  589%:-mode indomain_random(?).
  590indomain_random(X):-
  591	fd_size(X,Size),
  592	random(V),
  593	Index is 1+ (V mod Size),
  594	get_compact_domain_rep(X,L),
  595	nth_value(L,Index,Try),
  596	indomain_random(X,Try).
  597
  598%:-mode indomain_random(?,++).
  599indomain_random(X,Try) :-
  600  (   X #= Try 
  601  tor
  602      X #\= Try,
  603      indomain_random(X)
  604  ).
  605
  606
  607/****************************************************
  608
  609other useful stuff
  610
  611****************************************************/
  612
  613:-export(nth_value/3).  614
  615nth_value(V, 1, V) :-
  616	integer(V).
  617nth_value(I, N, V) :-
  618	I = _.._,
  619	nth_value1(I, [], N, V).
  620nth_value([I | R], N, V) :-
  621	nth_value1(I, R, N, V).
  622
  623nth_value1(A..B, R, N, V) :-
  624	A1 is A + N - 1,
  625	N1 is A1 - B,
  626	( N1 > 0 ->
  627	    nth_value(R, N1, V)
  628	;
  629	    A1 >= A,
  630	    V = A1
  631	).
  632nth_value1(A, R, N, V) :-
  633	atomic(A),
  634	nth_value2(A, R, N, V).
  635
  636nth_value2(A, _R, 1, V) :-
  637	!,
  638	V = A.
  639nth_value2(_A, R, N, V) :-
  640	N1 is N - 1,
  641	nth_value(R, N1, V)