% 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).