Change list domain swi-prolog clpfd - prolog

I'm using SWI-Prolog with clpfd library. The problem is that I generate a list of length N with items in 1..2^(N-1), constraining this list to have some properties and calculating the maximum of the ones that verify the constraint. After that I have to find the minimum of these maxima but there are too many cases to evaluate and Prolog ends to freeze.
maxConstrain(N,Max) :-
listN(List,N),
label(List),
constrain(List),
max_list(List,Max).
minMaxConstrain(N,M) :-
findall(Max,maxConstrain(N,Max),Maxs), min_list(Maxs,M).
listN(-List,+N) generate a list with N items in 1..2^(N-1).
maxConstrain(+N,-Max) gives the maximum of List if it verify the constraint.
minMaxConstrain(+N,-M) gives the minimum of all the evaluations of maxConstrain(N,Max).
Since I need the minimum of the maxima I thought to scale down the domain of the lists whenever I find a valid list with a maximum less than the original one. For example if I have N=4 the elements of the list will be in 1..8. Let's say I get two lists List1 and List2 with maximum 8 and 7 respectively. Now I have that every other valid list that contains 8 will be rejected since I have found List2 with the maximum = 7 that is less than 8. So my idea is to reset the range of the domain every time I find a maximum less than the previous. For example if the current domain is 1..Max1 and then I find Max2 < Max1 then I will set the domain to 1..Max2.
Is it possibile to do this?

The idea that you describe is what branch-and-bound algorithms do: you prune those parts of the search that cannot possibly lead to a better solution than the best one you have found so far. Constraint solvers normally provide this functionality in some form.
For example, in ECLiPSe, this is provided by library(branch_and_bound), and you would formulate your problem like
:- lib(ic).
:- lib(branch_and_bound).
min_of_max(N, Max) :-
length(Xs, N),
Xs #:: 1..2^(N-1),
constrain(Xs),
Max #= max(Xs),
bb_min(labeling(Xs), Max, _).
By wrapping the bb_min/3 call around the labeling/1 search routine, any attempt to create a list whose maximum is greater or equal than the smallest maximum found so far will lead to failure. By default, this is achieved by dynamically reducing the upper bound of Max (similar to the procedure you outlined in your question), but other strategy-options are available.

Related

Prolog project getting started

This is my first time asking a question on here. Sorry if I do something incorrectly.
First, I want to be up front; this is a homework question. I am not looking for anyone to do it for me. I just need help getting started.
The problem is-
Table of data
Using above information, Write a prolog program to answer the following queries.
Please note that you cannot simply answer these queries with only facts, you
should answer then using facts and rules.
A. Which country/countries has/have the largest case number?
B. Which country/countries has/have the smallest number of deaths?
C. Which country has the largest case number or the largest number of deaths?
D. Which country has the largest case number less than 5?
E. How many cases are reported for Austria?
F. How many cases are reported for the Asia?
G. How many cases are reported for the Asia and middle east?
H. Which region has the smallest case number?
I. Which region has the largest number of deaths?
J. Which regions have a smaller case number than Europe?
K. Which country/countries has/have a larger number of deaths than Iran?
L. Which country/countries has/have a larger case number and a larger number
of deaths than Iran?
M. Which country/countries has/have a larger case number or a larger number of
deaths than Iran?
N. What is the average case number in this report?
Ok so. I roughly understand how to complete the rules for how many cases are reported in X. That seems easy. But what I don't understand, is how we can traverse data and compare it in Prolog. In java for example, I would just put all the values in an array and sort it. Making this easy.
My question boils down to this:
How would you store the initial data from the table? (facts)
how would you write the rules to find the largest element?
Example for question A, using swi-prolog:
country_cases_deaths('Jordan', 35, 14).
country_cases_deaths('UK', 5, 3).
country_cases_deaths('Someplace Else', 35, 5).
country_cases_deaths('Austria', 2, 1).
country_max_cases(Country, MaxCases) :-
aggregate_all(
% Want the maximum
max(Cases),
% This is the filter
country_cases_deaths(_, Cases, _),
% Variable to put the max in
MaxCases
),
% Lookup country - could be multiple countries having the same max
country_cases_deaths(Country, MaxCases, _).
Result:
?- country_max_cases(Country, MaxCases).
Country = 'Jordan',
MaxCases = 35 ;
Country = 'Someplace Else',
MaxCases = 35.
?- findall(Country, country_max_cases(Country, _), Countries).
Countries = ['Jordan','Someplace Else'].
Some useful links: aggregate_all (click the orange "show source" icon in the top right, to see sourcecode), discussion
% dt.pl
data(japan,10).
data(usa,20).
readDatas(Datas):- findall(dt(Num,Country),data(Country,Num),Datas).
findMax(Datas,Max):-
sort(Datas,SortedDatas),reverse(SortedDatas,RevDatas),
[Max|_]=RevDatas.
:- readDatas(Datas),findMax(Datas,Max),writeln(Max).
:- halt.
$ apt install swi-prolog
$ swipl dt.pl

How could I remove backtracking from this code?

The goal is to select shapes that don't touch each other using constraints (clpfd). Calling start(Pairs,4) would return Pairs = [1,3,5,7].
One problem I noticed is that if I print Final before labeling, it prints [1,3,5,7]. Which means labeling isn't doing anything.
What could I change/add to this code in order to fix that and also remove possible backtracking?
:-use_module(library(clpfd)).
:-use_module(library(lists)).
% init initialises Pairs and Max
% Pairs - The elements inside the Nth list in Pairs,
% represent the index of the shapes that shape N can touch
init([[3,5,6,7],[4,5,7],[1,4,5,7],[2,3,7],[1,2,3,7],[1],[1,2,3,4,5]],7).
start(Final, N):-
init(Pairs, Max),
length(Final, N),
domain(Final, 1, Max),
ascending(Final),
all_different(Final),
rules(Pairs,Final),
labeling([],Final).
rules(_,[]).
rules(Pairs,[H|T]):-
nth1(H,Pairs,PairH),
secondrule(PairH,T),
rules(Pairs,T).
secondrule(_, []).
secondrule(PairH, [H|T]):-
element(_,PairH,H),
secondrule(PairH, T).
ascending([_|[]]).
ascending([H|[T1|T2]]):-
H #< T1,
ascending([T1|T2]).
This is an Independent Set problem, which is an NP-hard problem. Therefore, it is unlikely that anybody will ever find a way to do it without search (backtracking) for general instances.
Regarding your code, labeling/2 does nothing, because your rules/2 is in fact a search procedure that returns the solution it it can find it. all_different/1 is useless too, because it is implied by ascending/1.
Presumably, your goal is a program that sets up constraints (without any search) and then searches for a solution with labeling/2. For that, you need to rethink your constraint model. Read up a bit on independent sets.

Prolog recursion doesn't work the other way

I am learning Prolog and I got stuck in the code where the knowledge base and base rules are:
rectangle(a1, 3, 5). %Name,Width,Height
rectangle(a2, 1, 2).
rectangle(a3, 4, 3).
calcWH(T,C) :-
rectangle(T,W,_), C is W. % finds the width of the rect.
The recursive part is:
calcWTH([],0). % Base case
calcWTH([H | T ] ,K) :-
length([H|T],L),
L =< 3,
calcWTH(T,M),
calcWH(H,O),
K is O+M.
What I want to do with this code is, with calcWTH I want to calculate total width of the list of rectangles. For example
calcWTH([a1,a2,a3],A)
returns 8, as expected. The thing I'm puzzled is that this code only works for one way, not the other. For example when I make a query like
calcWTH(A,3)
It first finds A= [a1], then A=[a2,a2,a2], and afterwards I expect the program to stop because of the part length([H|T],L), L =< 3 But It gets into a loop indefinitely. What am I missing here?
Think about what this is doing:
length([H|T],L), L =< 3
Make a list
Check its length is less than 3, if it is - then success, other wise back track to length/2 and try making another list and then check if that list is length is less than 3.
But we know that list/2 is creating lists in order of larger size,
so we know that if list of length 3 fails, then the next list
created on back tracking will be bigger and all other lists.. but
prolog does not know that. You could imagine writing a length
predicate that searchs for lists in a differnt order, maybe
randomly, or from a predefined big size to ever smaller lists.
Then we would want the backtracking to work as is.
Anyway that is why you get infinite recursion, it will keep trying new lists, of ever increasing size.
You might find adding constraints is a good way to solve your problem:
Using a constrained variable with `length/2`

Prolog, finding smallest number without if statements

I am currently using tkEclipse for my prolog and am currently stuck at this question.
Given base cases of an item with their name and number, I need to be able to find the smallest number without using rules such as if statements.
eg. anime(gundam, 1978), anime(steins_gate, 2011), anime(prison_school, 2015). and the answer would say gundam is the smallest number. This must not be hard coded because if you were to change the knowledge base then it should also change answer. Also, it should work if there are only two animes in the knowledge base.
I was thinking of something like this to start:
anime(X, Y), anime(A,B), Y < B, but things after that get tricky because not allowed to use :-
findall(N, anime(A, N), S),
setof(X, member(X,S), [Min|_]).
Or, in one line:
setof(N, A^anime(A, N), [Min|_]).

Find best result without findall and a filter

I'm in a bit of pickle in Prolog.
I have a collection of objects. These objects have a certain dimension, hence weight.
I want to split up these objects in 2 sets (which form the entire set together) in such a way that their difference in total weight is minimal.
The first thing I tried was the following (pseudo-code):
-> findall with predicate createSets(List, set(A, B))
-> iterate over results while
---> calculate weight of both
---> calculate difference
---> loop with current difference and compare to current difference
till end of list of sets
This is pretty straightforward. The issue here is that I have a list of +/- 30 objects. Creating all possible sets causes a stack overflow.
Helper predicates:
sublist([],[]).
sublist(X, [_ | RestY]) :-
sublist(X,RestY).
sublist([Item|RestX], [Item|RestY]) :-
sublist(RestX,RestY).
subtract([], _, []) :-
!.
subtract([Head|Tail],ToSubstractList,Result) :-
memberchk(Head,ToSubstractList),
!,
subtract(Tail, ToSubstractList, Result).
subtract([Head|Tail], ToSubstractList, [Head|ResultTail]) :-
!,
subtract(Tail,ToSubstractList,ResultTail).
generateAllPossibleSubsets(ListToSplit,sets(Sublist,SecondPart)) :-
sublist(Sublist,ListToSplit),
subtract(ListToSplit, Sublist, SecondPart).
These can then be used as follows:
:- findall(Set, generateAllPossibleSubsets(ObjectList,Set), ListOfSets ),
findMinimalDifference(ListOfSets,Set).
So because I think this is a wrong way to do it, I figured I'd try it in an iterative way. This is what I have so far:
totalWeightOfSet([],0).
totalWeightOfSet([Head|RestOfSet],Weight) :-
objectWeight(Head,HeadWeight),
totalWeightOfSet(RestOfSet, RestWeight),
Weight is HeadWeight + RestWeight.
findBestBalancedSet(ListOfObjects,Sets) :-
generateAllPossibleSubsets(ListOfObjects,sets(A,B)),
totalWeightOfSet(A,WeightA),
totalWeightOfSet(B,WeightB),
Temp is WeightA - WeightB,
abs(Temp, Difference),
betterSets(ListOfObjects, Difference, Sets).
betterSets(ListOfObjects,OriginalDifference,sets(A,B)) :-
generateAllPossibleSubsets(ListOfObjects,sets(A,B)),
totalWeightOfSet(A,WeightA),
totalWeightOfSet(B,WeightB),
Temp is WeightA - WeightB,
abs(Temp, Difference),
OriginalDifference > Difference,
!,
betterSets(ListOfObjects, Difference, sets(A, B)).
betterSets(_,Difference,sets(A,B)) :-
write_ln(Difference).
The issue here is that it returns a better result, but it hasn't traversed the entire solution tree. I have a feeling this is a default Prolog scheme I'm missing here.
So basically I want it to tell me "these two sets have the minimal difference".
Edit:
What are the pros and cons of using manual list iteration vs recursion through fail
This is a possible solution (the recursion through fail) except that it can not fail, since that won't return the best set.
I would generate the 30 objects list, sort it descending on weight, then pop objects off the sorted list one by one and put each into one or the other of the two sets, so that I get the minimal difference between the two sets on each step. Each time we add an element to a set, just add together their weights, to keep track of the set's weight. Start with two empty sets, each with a total weight of 0.
It won't be the best partition probably, but might come close to it.
A very straightforward implementation:
pair(A,B,A-B).
near_balanced_partition(L,S1,S2):-
maplist(weight,L,W), %// user-supplied predicate weight(+E,?W).
maplist(pair,W,L,WL),
keysort(WL,SL),
reverse(SL,SLR),
partition(SLR,0,[],0,[],S1,S2).
partition([],_,A,_,B,A,B).
partition([N-E|R],N1,L1,N2,L2,S1,S2):-
( abs(N2-N1-N) < abs(N1-N2-N)
-> N3 is N1+N,
partition(R,N3,[E|L1],N2,L2,S1,S2)
; N3 is N2+N,
partition(R,N1,L1,N3,[E|L2],S1,S2)
).
If you insist on finding the precise answer, you will have to generate all the partitions of your list into two sets. Then while generating, you'd keep the current best.
The most important thing left is to find the way to generate them iteratively.
A given object is either included in the first subset, or the second (you don't mention whether they're all different; let's assume they are). We thus have a 30-bit number that represents the partition. This allows us to enumerate them independently, so our state is minimal. For 30 objects there will be 2^30 ~= 10^9 generated partitions.
exact_partition(L,S1,S2):-
maplist(weight,L,W), %// user-supplied predicate weight(+E,?W).
maplist(pair,W,L,WL),
keysort(WL,SL), %// not necessary here except for the aesthetics
length(L,Len), length(Num,Len), maplist(=(0),Num),
.....
You will have to implement the binary arithmetics to add 1 to Num on each step, and generate the two subsets from SL according to the new Num, possibly in one fused operation. For each freshly generated subset, it's easy to calculate its weight (this calculation too can be fused into the same generating operation):
maplist(pair,Ws,_,Subset1),
sumlist(Ws,Weight1),
.....
This binary number, Num, is all that represents our current position in the search space, together with the unchanging list SL. Thus the search will be iterative, i.e. running in constant space.

Resources