How to maximize the goal in prolog? - prolog

I am trying to solve the knapsack problem in prolog. Following is my implementation.
% 'ks' is compound term which has 4 argumets
% 1 - List of items to be chosen from.
% 2 - Maximum weight a knapsack can carry.
% 3 - Selected items which sum of weights is less than or equal to knapsack capacity.
% 4 - The gain after choosing the selected item.
% base conditions where input list contains only one items and
% it is either selected or excluded.
ks([item(W1, V1)], W, [item(W1, V1)], V1):- W1 =< W.
ks([item(W1, _)], W, [], 0):- W1 > W.
% An item from the input list is chosen in the knapsack.
% In that case, we recurse with smaller list with reduced weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append(Prefix, [item(W1, V1)|Suffix], ItemList),
append(Prefix, Suffix, RemList),
NewWeight is MaxWeight - W1,
W1 =< MaxWeight,
append([item(W1, V1)], SelectItems1, SelectItems),
ks(RemList, NewWeight, SelectItems1, Gain1),
Gain is V1 + Gain1.
% An item from the input list is not chosen in the knapsack.
% In that case, we recurse with smaller list but with the same weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append([P1|Prefix], [item(W1, V1)|Suffix], ItemList),
append([P1|Prefix], Suffix, RemList),
not(member(item(W1, V1), SelectItems)),
ks(RemList, MaxWeight, SelectItems, Gain).
The input to the program will be list of items as below. in term item(W, V) W is weight of the item while V is value of the item. Goal to maximize the value for the given weight constraint.
ks([item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)], 20, List, Gain).
List = [item(2, 3), item(3, 4), item(4, 5), item(5, 8)],
Gain = 20 ;
While I am able to generate all the combinations of items with above program, I am not able to code to find out the maximum gain only.
Could any one please point me the right direction?
Thanks.

I think that to find reusable abstractions it's an important point of studying programming. If we have a subset_set/2 that yields on backtracking all subsets, ks/4 becomes really simple:
subset_set([], _).
subset_set([H|T], Set) :-
append(_, [H|Rest], Set),
subset_set(T, Rest).
ks(Set, Limit, Choice, Gain) :-
subset_set(Choice, Set),
aggregate((sum(W), sum(G)), member(item(W, G), Choice), (TotWeight, Gain)),
TotWeight =< Limit.
and then
ks_max(Items, Limit, Sel, WMax) :-
aggregate(max(W,I), ks(Items,Limit,I,W), max(WMax,Sel)).
despite its simplicity, subset_set/2 is not really easy to code, and library available alternatives (subset/2, ord_subset/2) don't enumerate, but only check for the relation.

There are at least two things you can do, depending on how you want to approach this.
You could simply collect all solutions and find the maximum. Something along the lines of:
?- Items = [item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)],
findall(Gain-List, ks(Items, 20, List, Gain), Solutions),
sort(Solutions, Sorted),
reverse(Sorted, [MaxGain-MaxList|_]).
% ...
MaxGain = 26,
MaxList = [item(9, 10), item(5, 8), item(4, 5), item(2, 3)].
So you find all solutions, sort them by Gain, and take the last. This is just one way to do it: if you don't mind collecting all solutions, it is up to you how you want to pick out the solution you need from the list. You might also want to find all maximum solutions: see this question and answers for ideas how to do that.
The cleaner approach would be to use constraints. As the comment to your questions points out, it is not very clear what you are actually doing, but the way to go would be to use a library like CLP(FD). With it, you could simply tell labeling/2 to look for the maximum Gain first (once you have expressed your problem in terms of constraints).

greedy Approximation algorithm :
pw((P,W),Res) :- PW is P/W, Res=(PW,P,W).
pws(Ps_Ws,PWs) :- maplist(pw,Ps_Ws,PWs).
sort_desc(List,Desc_list) :-
sort(List,Slist),
reverse(Slist,Desc_list).
ransack_([],_,_,[]).
ransack_([(_,P,W)|PWs],Const,Sum,Res) :-
Sum1 is W+Sum,
Sum1 < Const ->
Res=[(P,W)|Res1],
ransack_(PWs,Const,Sum1,Res1)
;ransack_(PWs,Const,Sum,Res).
% ransack(+[(P,W)|..],+W,,Res)
ransack(L_PWs,W,Res) :-
pws(L_PWs,Aux),
sort_desc(Aux,PWs),
ransack_(PWs,W,0,Res).
Test
item(W, V)-->(V,W)
| ?- ransack([(3,2),(4,3),(5,4),(8,5),(10,9)],20,Res).
Res = [(8,5),(3,2),(4,3),(5,4)] ? ;
no

Related

How can I verify if a coordinate is in a list

I'm generating random coordinates and adding on my list, but first I need verify if that coordinate already exists. I'm trying to use member but when I was debugging I saw that isn't working:
My code is basically this:
% L is a list and Q is a count that define the number of coordinate
% X and Y are the coordinate members
% check if the coordniate already exists
% if exists, R is 0 and if not, R is 1
createCoordinates(L,Q) :-
random(1,10,X),
random(1,10,Y),
convertNumber(X,Z),
checkCoordinate([Z,Y],L,R),
(R is 0 -> print('member'), createCoordinates(L,Q); print('not member'),createCoordinates(L,Q-1).
checkCoordinate(C,L,R) :-
(member(C,L) -> R is 0; R is 1).
% transforms the number N in a letter L
convertNumber(N,L) :-
N is 1, L = 'A';
N is 2, L = 'B';
...
N is 10, L = 'J'.
%call createCoordinates
createCoordinates(L,20).
When I was debugging this was the output:
In this picture I'm in the firts interation and L is empty, so R should be 1 but always is 0, the coordinate always is part of the list.
I have the impression that the member clause is adding the coordinate at my list and does'nt make sense
First off, I would recommend breaking your problem down into smaller pieces. You should have a procedure for making a random coordinate:
random_coordinate([X,Y]) :-
random(1, 10, XN), convertNumber(XN, X),
random(1, 10, Y).
Second, your checkCoordinate/3 is converting Prolog's success/failure into an integer, which is just busy work for Prolog and not really improving life for you. memberchk/2 is completely sufficient to your task (member/2 would work too but is more powerful than necessary). The real problem here is not that member/2 didn't work, it's that you are trying to build up this list parameter on the way out, but you need it to exist on the way in to examine it.
We usually solve this kind of problem in Prolog by adding a third parameter and prepending values to the list on the way through. The base case then equates that list with the outbound list and we protect the whole thing with a lower-arity procedure. In other words, we do this:
random_coordinates(N, Coordinates) :- random_coordinates(N, [], Coordinates).
random_coordinates(0, Result, Result).
random_coordinates(N, CoordinatesSoFar, FinalResult) :- ...
Now that we have two things, memberchk/2 should work the way we need it to:
random_coordinates(N, CoordinatesSoFar, FinalResult) :-
N > 0, succ(N0, N), % count down, will need for recursive call
random_coordinate(Coord),
(memberchk(Coord, CoordinatesSoFar) ->
random_coordinates(N, CoordinatesSoFar, FinalResult)
;
random_coordinates(N0, [Coord|CoordinatesSoFar], FinalResult)
).
And this seems to do what we want:
?- random_coordinates(10, L), write(L), nl.
[[G,7],[G,3],[H,9],[H,8],[A,4],[G,1],[I,9],[H,6],[E,5],[G,8]]
?- random_coordinates(10, L), write(L), nl.
[[F,1],[I,8],[H,4],[I,1],[D,3],[I,6],[E,9],[D,1],[C,5],[F,8]]
Finally, I note you continue to use this syntax: N is 1, .... I caution you that this looks like an error to me because there is no distinction between this and N = 1, and your predicate could be stated somewhat tiresomely just with this:
convertNumber(1, 'A').
convertNumber(2, 'B').
...
My inclination would be to do it computationally with char_code/2 but this construction is actually probably better.
Another hint that you are doing something wrong is that the parameter L to createCoordinates/2 gets passed along in all cases and is not examined in any of them. In Prolog, we often have variables that appear to just be passed around meaninglessly, but they usually change positions or are used multiple times, as in random_coordinates(0, Result, Result); while nothing appears to be happening there, what's actually happening is plumbing: the built-up parameter becomes the result value. Nothing interesting is happening to the variable directly there, but it is being plumbed around. But nothing is happening at all to L in your code, except it is supposedly being checked for a new coordinate. But you're never actually appending anything to it, so there's no reason to expect that anything would wind up in L.
Edit Notice that #lambda.xy.x solves the problem in their answer by prepending the new coordinate in the head of the clause and examining the list only after the recursive call in the body, obviating the need for the second list parameter.
Edit 2 Also take a look at #lambda.xy.x's other solution as it has better time complexity as N approaches 100.
Since i had already written it, here is an alternative solution: The building block is gen_coord_notin/2 which guarantees a fresh solution C with regard to an exclusion list Excl.
gen_coord_notin(C, Excl) :-
random(1,10,X),
random(1,10,Y),
( memberchk(X-Y, Excl) ->
gen_coord_notin(C, Excl)
;
C = X-Y
).
The trick is that we only unify C with the new result, if it is fresh.
Then we only have to fold the generations into N iterations:
gen_coords([], 0).
gen_coords([X|Xs], N) :-
N > 0,
M is N - 1,
gen_coords(Xs, M),
gen_coord_notin(X, Xs).
Remark 1: since coordinates are always 2-tuples, a list representation invites unwanted errors (e.g. writing [X|Y] instead of [X,Y]). Traditionally, an infix operator like - is used to seperate tuples, but it's not any different than using coord(X,Y).
Remark 2: this predicate is inherently non-logical (i.e. calling gen_coords(X, 20) twice will result in different substitutions for X). You might use the meta-level predicates var/1, nonvar/1, ground/1, integer, etc. to guard against non-sensical calls like gen_coord(1-2, [1-1]).
Remark 3: it is also important that the conditional does not have multiple solutions (compare member(X,[A,B]) and memberchk(X,[A,B])). In general, this can be achieved by calling once/1 but there is a specialized predicate memberchk/2 which I used here.
I just realized that the performance of my other solutions is very bad for N close to 100. The reason is that with diminishing possible coordinates, the generate and test approach will take longer and longer. There's an alternative solution which generates all coordinates and picks N random ones:
all_pairs(Ls) :-
findall(X-Y, (between(1,10,X), between(1,10,Y)), Ls).
remove_index(X,[X|Xs],Xs,0).
remove_index(I,[X|Xs],[X|Rest],N) :-
N > 0,
M is N - 1,
remove_index(I,Xs,Rest,M).
n_from_pool(_Pool, [], 0).
n_from_pool(Pool, [C|Cs], N) :-
N > 0,
M is N - 1,
length(Pool, L),
random(0,L,R),
remove_index(C,Pool,NPool,R),
n_from_pool(NPool, Cs, M).
gen_coords2(Xs, N) :-
all_pairs(Pool),
n_from_pool(Pool, Xs, N).
Now the query
?- gen_coords2(Xs, 100).
Xs = [4-6, 5-6, 5-8, 9-6, 3-1, 1-3, 9-4, 6-1, ... - ...|...] ;
false.
succeeds as expected. The error message
?- gen_coords2(Xs, 101).
ERROR: random/1: Domain error: not_less_than_one' expected, found0'
when we try to generate more distinct elements than possible is not nice, but better than non-termination.

Prolog: Exam schedule generator - How to avoid permutations in solutions

I'm building an exam scheduler in Prolog.
The scheduler is based on this example:
https://metacpan.org/source/DOUGW/AI-Prolog-0.741/examples/schedule.pl
How can I make sure there are no permutations in my solution?
For example solution
-> ((exam1, teacher1, time1, room1), (exam2, teacher2, time2, room2))
Later solution:
-> ((exam2, teacher2, time2, room2),(exam1, teacher1, time1, room1))
How can I avoid this?
Thanks!
1) The closest/easiest from what you've got is to check that the course you've chosen is strictly bigger in order than the previous one.
For example by adding an extra predicate which also includes the previous course in the combination.
%%makeListPrev(PreviousTakenCourse, ResultCombinationOfCourses, NrOfCoursesToAdd)
makeListPrev(_,[], 0).
makeListPrev(course(Tprev,Ttime,Troom),[course(Teacher,Time,Room)|Rest], N) :-
N > 0,
teacher(Teacher),
classtime(Time),
classroom(Room),
course(Tprev,Ttime,Troom) #< course(Teacher,Time,Room), %% enforce unique combinations
is(M,minus(N,1)),
makeListPrev(course(Teacher,Time,Room),Rest,M).
In this way you eliminate all duplicate permutations of the same combination by always taking the lexographically smallest.
E.g if you have 4 courses:
(a,b,c,d)
(a,b,d,c) % d can't be before c
(a,c,b,d) % c can't be before b
...
2) Another way to solve this quite easily is to first create a list of all possible courses. And then take out all possible combinations of N sequentially.
scheduler(L) :-
%% Find all possible courses
findall(course(Teacher,Time,Room),(teacher(Teacher),classtime(Time),classroom(Room)),Courses),
makeList(Courses,4,L),
different(L).
makeList([],0,[]) :- !. %% list completed
makeList([H|T],N,[H|Res]) :- %% list including H
M is N-1,
makeList(T,M,Res).
makeList([_|T], N, Res) :- makeList(T, N, Res). %% list without H

How I can add all the data in a knowledge base in Prolog?

I need help with this exercise of Prolog:
% items
items (cell).
items (labial).
items (control).
items (mirror).
% Weight of each item
weight (cell 2).
weight (labial, 3).
weight (control, 5).
weight (mirror, 10).
capacity (X, Y, Z, V) :-
weight (X C1), weight (Y, C2), weight (Z, C3), sum (C1, C2, C3, R), V> = R.
sum (X, Y, Z, K) :- K is X + Y + Z.
this program does is give me a combination of 3 items or less a given weight, eg capacity (X, Y, Z, 15).
result is, X: cell, Y: Lipstick, Z: mirror, X: control, Y: cell, Z: mirror. successively with all combinations where the sum of the 3 weight no higher input.
At the moment I am limited by the number of income variables manually, capacity (X, Y, Z, N. .......) I want that the combination with respect to number of items that are in the knowledge base, not manually enter the variables. How I can do that?
so would be ideal capacity (weight) and response.
the combination of items where the weight does not exceed
phone, lipstick, mirror.
control labial phone.
mirror, control, labilal .......
Sorry I do not speak English, I'm using google translator.
It looks like the structure that you are looking for is a list and you should look it up ([HD:TL] where TL is a list). The solution I provide below should show how to use lists to the desired effect although my solution allows duplicates and doesn't care about the order of the list. If this is for homework, you should be able to figure out how to fix that on your own once you know a little about lists.
Basically, the first predicate handles making long lists of items, HD is an item with weight X, and it looks for a predicate to define the tail (TL) list; the second handles the end of a list (TL is [] in the previous inductive step) and empty lists (because even empty lists need love too).
items(cell).
items(labial).
items(control).
items(mirror).
weight(cell,2).
weight(labial,3).
weight(control,5).
weight(mirror,10).
capacity(W, [HD|TL]) :- items(HD),weight(HD,X),W>0,capacity(W-X,TL).
capacity(W, []) :- W>=0.

Longest increasing subset Prolog

I want to create in Prolog to find longest increasing subset of entered list. For example, you enter list of [3,1,2] and the output is [1,2],
?- subset([3,1,2], X).
X = [1,2]
I have code which shows all the subsets of this list:
subset([],[]).
subset([_|X],Y):-subset(X,Y).
subset([A|X],[A|Y]):-subset(X,Y).
Can anyone help me to find just the longest increasing subset?
Do you mean [1,3,5,6,7] to be the answer for [4,1,3,8,9,5,6,7]? IOW, do you really mean subsets, or just sublists, i.e. contiguous portions of the list?
If the latter is the case, you won't need subsets. The search is linear. If in a list [a,b,c,d,e,f] you find that d > e and the increasing sequence [a,b,c,d] stops, you don't need to restart the search from b now: the sequence will still break at d. You will just continue your search from e.
So, we'll just carry around some additional information during the search, viz. the current and the winning-so-far sub-sequences. And their lengths.
longest_incr([],0-[]).
longest_incr([A|B],RL-R):- % R is the result, of length RL
longest_aux(B,[],0, [A],1, RL-R).
longest_aux([], Win,N, Curr,K, RL-R):-
( K>N -> RL=K, reverse(Curr,R) ; RL=N, reverse(Win,R) ).
longest_aux([A|B],Win,N, Curr,K, RL-R):- Curr = [X|_], L is K,
( A>X -> longest_aux(B,Win, N, [A|Curr],L+1,RL-R) % keep adding
; L>N -> longest_aux(B,Curr,K, [A], 1, RL-R) % switch the winner
; longest_aux(B,Win, N, [A], 1, RL-R) % winner unbeaten
).
If OTOH you really need the longest subset ... there's a contradiction there. A set can have its elements rearranged, so the longest subset of a given list will be
longset_subset(L,R):- sort(L,S), R=S.
Perhaps you mean the longest order-preserving sub-sequence, i.e. it is allowed to be non-contiguous. Then you can gather all solutions to your subset with findall or similar predicate, and analyze these results:
longest_subseq(L,R):-
findall( S, subset(L,S), X),
maplist( longest_incr, X, Y),
keysort( Y, Z),
last( Z, _Len-R).
The above has a lot of redundancy in it. We can attempt to improve its efficiency by only allowing the increasing subsequences:
incr_subseq([],[]).
incr_subseq([_|X],Y):- incr_subseq(X,Y).
incr_subseq([A|X],[A|Y]):- incr_subseq(X,Y), ( Y=[] ; Y=[B|_], A<B).
Now all the sub-sequences found by the above predicate will be increasing, so we can just take their lengths:
lenlist(List,Len-List) :- length(List,Len).
longest_subseq(L,R):-
findall( S, incr_subseq(L,S), X),
maplist( lenlist, X, Y),
keysort( Y, Z),
last( Z, _Len-R).
Or, the linear searching longest_incr could be tweaked for a more efficient solution. Instead of maintaining just one winning sub-sequence, it would maintain all the relevant possibilities as it goes along the input list.
Just out of curiosity, would it be possible in prolog to realize something like this for finding longest increasing subsequence:
You find all subsets of list
Than you find, which of these subsets are increasing
And then you search for the longest
If it's possible, how could I do that in Prolog?

create a list from a list of lists

I need to do the following: given a list of lists I need to find all possible combinations of the lists such that if some of these lists belong in such a combination, then they have no elements in common and the list created by appending the lists in the combination has a given length. Any ideas?
Example:
Say P= [[1,2,3],[4,5,6],[2,5],[7,9],[7,10],[8],[10]].
N a given number, say N=10. I need to search through P in order to find appropriate lists, with no elements in common, and add them in a list L such that the length of the union of L is 10. So in the above example :
L=[[1,2,3],[4,5,6],[7,9],[8],[10]]. It might be very easy but I'm new in Prolog
Given nobody's answered, and it's been quite a while since I've written anything in Prolog and I figured I needed the practice, here's how you'd do it.
First, to make generating the combinations easier, we create a term to preprocess the lists to pair them with their lengths to avoid having to get the lengths multiple times. The cut avoids needless backtracking:
with_lengths([], []) :- !.
with_lengths([H|T1], [(Len, H)|T2]) :-
length(H, Len),
with_lengths(T1, T2).
Here's the comb/3 predicate, which you use for generating the combinations:
comb(L, R, Max) :-
with_lengths(L, L1),
comb1(L1, R, Max).
comb1/3 does the actual work. The comments explain what's going on:
% Combination works.
comb1([], [], 0).
% Try combining the current element with the remainder.
comb1([(Len, Elem)|T1], [Elem|T2], Max) :-
NewMax is Max - Len,
comb1(T1, T2, NewMax).
% Alternatively, ignore the current element and try
% combinations with the remainder.
comb1([_|T1], T2, Max) :-
comb1(T1, T2, Max).

Resources