Related
I need to do an exercise similar to this:
Prolog - Split a list in two halves, reversing the first half.
I am asked to take a list of letters into two lists that are either equal in size (even sized original list I guess) or one is larger than the other by one element (odd sized list), and reverse the first one while I'm at it, but using only difference lists.
These are the required query and output
?-dividelist2([a,b,c,d,e,f | T] - T, L1-[], L2-[]).
L1 = [c,b,a]
L2 = [d,e,f]
?-dividelist2([a,b,c,d,e | T] - T, L1-[], L2-[]).
L1 = [c,b,a]
L2 = [d,e]
% OR
L1 = [b,a]
L2 = [c,d,e]
This is my code using the previous example but modified, I don't know how to properly compare the two lists
"deduct" them from the input and produce [d,e,f]?
dividelist2(In -[], L1-[], L2-[]) :-
length_dl(In - [],L), % length of the list
FL is L//2, % integer division, so half the length, Out1 will be 1 shorter than Out2 if L is odd
( \+ (FL*2 =:= L), % is odd
FLP is FL + 1 % odd case
; FLP = FL % odd and even case
),
take(In,FLP,FirstHalf),
conc([FirstHalf| L2]-l2,L2-[],In-[]),
reverse1(FirstHalf-[], L1-[]). % do the reverse
reverse1(A- Z,L - L):-
A == Z , !.
reverse1([X|Xs] - Z,L - T):-
reverse1(Xs - Z, L - [X|T]).
length_dl(L- L,0):-!.
length_dl([X|T] - L,N):-
length_dl(T- L,N1),
N is N1 + 1 .
take(Src,N,L) :- findall(E, (nth1(I,Src,E), I =< N), L).
conc(L1-T1,T1-T2,L1-T2).
This is the current trace:
Call:dividelist2([a, b, c, d, e, f|_22100]-_22100, _22116-[], _22112-[])
Call:length_dl([a, b, c, d, e, f]-[], _22514)
Call:length_dl([b, c, d, e, f]-[], _22520)
Call:length_dl([c, d, e, f]-[], _22526)
Call:length_dl([d, e, f]-[], _22532)
Call:length_dl([e, f]-[], _22538)
Call:length_dl([f]-[], _22544)
Call:length_dl([]-[], _22550)
Exit:length_dl([]-[], 0)
Call:_22554 is 0+1
Exit:1 is 0+1
Exit:length_dl([f]-[], 1)
Call:_22560 is 1+1
Exit:2 is 1+1
Exit:length_dl([e, f]-[], 2)
Call:_22566 is 2+1
Exit:3 is 2+1
Exit:length_dl([d, e, f]-[], 3)
Call:_22572 is 3+1
Exit:4 is 3+1
Exit:length_dl([c, d, e, f]-[], 4)
Call:_22578 is 4+1
Exit:5 is 4+1
Exit:length_dl([b, c, d, e, f]-[], 5)
Call:_22584 is 5+1
Exit:6 is 5+1
Exit:length_dl([a, b, c, d, e, f]-[], 6)
Call:_22590 is 6//2
Exit:3 is 6//2
Call:3*2=:=6
Exit:3*2=:=6
Call:_22590=3
Exit:3=3
Call:take([a, b, c, d, e, f], 3, _22594)
Call:'$bags' : findall(_22518, (nth1(_22514, [a, b, c, d, e, f], _22518),_22514=<3), _22614)
Exit:'$bags' : findall(_22518, '251db9a2-f596-4daa-adae-38a38a13842c' : (nth1(_22514, [a, b, c, d, e, f], _22518),_22514=<3), [a, b, c])
Exit:take([a, b, c, d, e, f], 3, [a, b, c])
Call:conc([[a, b, c]|_22112]-l2, _22112-[], [a, b, c, d, e, f]-[])
Fail:conc([[a, b, c]|_22112]-l2, _22112-[], [a, b, c, d, e, f]-[])
Fail:dividelist2([a, b, c, d, e, f|_22100]-_22100, _22116-[], _22112-[])
false
thanks
This is not an answer but testing and debugging suggestions that doesn't fit the comment length limit. The suggestions use Logtalk, which you can run with most Prolog systems.
From your question, the dividelist2/3 predicate needs to satisfy a couple of properties, one of them describing the lengths of the resulting lists. We can express this property easily using a predicate, p/1:
p(DL) :-
difflist::length(DL, N),
dividelist2(DL, DL1, DL2),
difflist::length(DL1, N1),
difflist::length(DL2, N2),
N is N1 + N2,
abs(N1 - N2) =< 1.
Here I'm using Logtalk's difflist library object to compute the length of the difference lists. Given this predicate, we can now perform some property-testing of your dividelist2/3 predicate.
Using Logtalk lgtunit tool implementation of property-testing, we get:
?- lgtunit::quick_check(p(+difference_list(integer))).
* quick check test failure (at test 1 after 0 shrinks):
* p(A-A)
false.
I.e. your code fails for the trivial case of an empty difference list. In the query, we use the difference_list(integer) type simply to simplify the generated counter-examples.
Let's try to fix the failure by adding the following clause to your code:
dividelist2(A-A, B-B, C-C).
Re-trying our test query, we now get:
?- lgtunit::quick_check(p(+difference_list(integer))).
* quick check test failure (at test 2 after 0 shrinks):
* p([0|A]-A)
false.
I.e. the dividelist2/3 predicate fails for a difference list with a single element. You can now use the difference list in the generated counter-example as a starting point for debugging:
?- dividelist2([0|A]-A, L1, L2).
A = [0|A],
L1 = _2540-_2540,
L2 = _2546-_2546 ;
false.
You can also use property-testing with your auxiliary predicates. Take the length_dl/2 predicate. We can compare it with another implementation of a predicate that computes the length of a difference list, e.g. the one in the Logtalk library, by defining another property:
q(DL) :-
difflist::length(DL, N),
length_dl(DL, N).
Testing it we get:
?- lgtunit::quick_check(q(+difference_list(integer))).
* quick check test failure (at test 3 after 0 shrinks):
* q([-113,446,892|A]-A)
false.
Effectively, using the counter.example, we get:
?- length_dl([-113,446,892|A]-A, N).
A = [-113, 446, 892|A],
N = 0.
Hope that this insight helps in fixing your code.
Ok, my idea can work, but seems somewhat inelegant. We'll begin with a handy utility that'll turn a list into a difference list:
list_dl([], W-W).
list_dl([H|T1], [H|T2]-W) :-
list_dl(T1, T2-W).
Now we want a predicate to take the first and last element from the difference list. The case where there's only one element left will need to be handled differently, so we'll make that one unique.
head_last(Head, Head, DL-Hole, one) :-
once(append([Head|_], [Last, Hole], DL)),
var(Last), !.
head_last(Head, Last, DL-Hole, New) :-
once(append([Head|Mid], [Last, Hole], DL)),
list_dl(Mid, New).
Now we can create our recursive split and reverse predicate, which has 3 base cases:
splitrev(W-W, [], []) :- var(W), !. % Empty base case.
splitrev(DL, [V|[]], []) :- head_last(V, V, DL, one).
splitrev(DL, [], [V|[]]) :- head_last(V, V, DL, one).
splitrev(DL, [Head|Front], [Last|Back]) :-
head_last(Head, Last, DL, Rest),
splitrev(Rest, Front, Back).
Unfortunately it's much easier to add an element to the back of a difference list than it is to get an element from the back, plus getting that element closed the hole in the list. Therefore I think a different strategy would be better.
I'm new to constraint-programming (coming from c#) and I'm trying to solve this problem. Unfortunately I don't have a name for this kind of puzzle so I'm not sure what to search for. The closest examples I can find are Nonogram and Tomography puzzles.
Puzzle description:
The player is given an empty game board (varying size) that they must fill with n-colors, using clue patterns for the rows and columns. Each clue pattern is the sequence of colors in that row/col but with consecutive duplicates removed.
Here is an example easy small 4x4 grid with 3 colors:
rbg,rbr,grb,bgbg <- (top-to-bottom column constraints)
_,_,_,_ rgb <- (row constraints)
_,_,_,_ brg
_,_,_,_ b
_,_,_,_ grbg
Solutions (2):
r,r,g,b
b,?,r,g
b,b,b,b
g,r,b,g
? Can be either red or blue but not green.
Pattern examples below.
Examples given 6-length sequences to pattern:
aaaaaa -> a
aabbcc -> abc
abbbbc -> abc
cabbbc -> cabc
bbbaac -> bac
abbaab -> abab
abcabc -> abcabc
Examples given pattern to potential solution sequences:
abc -> abc (3 length solution)
abc -> abcc, abbc, aabc (4 length solutions)
abc -> abccc, abbcc, abbbc, aabbc, aaabc (5 length solutions)
I've tried to solve it in C# or-tools and MiniZinc but the biggest problem I have is building the constraints. I can generate the patterns from a sequence (in c# imperative way) but then how to turn that into a constraint?
How I'm thinking about it: generate all potential sequences from each clue pattern. Then make a constraint for the corresponding row/col that says it must be one of those sequences.
Example from top row in above puzzle: rgb to [4-length sequences] -> rgbb, rggb, rrgb, and then add a constraint for that row: must equal one of these sequences.
Am I thinking about this right? Any smarter ways to do it?
Thanks for any advice.
=====================================
Edit after some progress:
This MiniZinc correctly solves the top row for the pattern abc which has 3 solutions of 4 length: aabc, abbc, abcc.
include "globals.mzn";
array [1..4, 1..4] of var 1..3: colors;
constraint regular(row(colors, 1), 4, 3,
[|
% a, b, c
2,0,0| % accept 'a'
2,3,0| % accept 'a' or 'b' ?
0,3,4| % accept 'b' or 'c' ?
0,0,4| % accept 'c'
|], 1, {4});
% Don't care about rest of grid for now.
constraint forall(i,j in 1..4 where i > 1) (row(colors, i)[j] = 1);
solve satisfy;
output [show(colors)];
However I'm not sure how to handle larger grids with many patterns other than hardcoding everything like this. I will experiment a bit more.
The constraints you are talking about seem to be easily represented as regular expressions. For example your abc example with varying length can be caught using the regular expression abc.*, which requires one a then one b, and then one c, it will accept anything else afterwards.
In MiniZinc these kinds of constraints are expressed using the regular predicate. The regular predicate simulates an automaton with accepting states. By providing the allowed state-transitions the model is constraint.
The example expression abc.* would be enforced by the following constraint item:
% variables considered, nr states, input values
constraint regular(VARS, 4, 1..3, [|
% a, b, c
2,0,0| % accept 'a'
0,3,0| % accept 'b'
0,0,4| % accept 'c'
4,4,4| % accept all
|], 1, {4}); % initial state, accepting states
In Prolog(language), I use DCG form to describe such problems. It is extended BNF form.
So I suggest finding approach with Extended BNF Form in your environment.
SWI-Prolog example:
color_chunk_list(Encoded,Decoded):-
phrase(chunk_list(Encoded),Decoded),
chk_continuity(Encoded).
chunk_list([])-->[].
chunk_list([First|Rest])-->colorrow(First),chunk_list(Rest).
colorrow(Color)-->[Color],colorrow(Color).
colorrow(Color)-->[Color].
chk_continuity([First,Second|Rest]):-First \= Second,chk_continuity([Second|Rest]).
chk_continuity([_]).
In this program, encodings and decodings are bidirectional.
Tests:
?- length(L,4),color_chunk_list([r,g],L).
L = [r, r, r, g] ;
L = [r, r, g, g] ;
L = [r, g, g, g] ;
false.
?- length(L,6),color_chunk_list([a,b,c],L).
L = [a, a, a, a, b, c] ;
L = [a, a, a, b, b, c] ;
L = [a, a, a, b, c, c] ;
L = [a, a, b, b, b, c] ;
L = [a, a, b, b, c, c] ;
L = [a, a, b, c, c, c] ;
L = [a, b, b, b, b, c] ;
L = [a, b, b, b, c, c] ;
L = [a, b, b, c, c, c] ;
L = [a, b, c, c, c, c] ;
false.
?- color_chunk_list(L,[a,a,b,b,c,c]).
L = [a, b, c] ;
false.
?- color_chunk_list(L,[b,r,b,r,r,g,g,b]).
L = [b, r, b, r, g, b] ;
false.
In ECLiPSe, which is prolog based CLP system (not IDE one),
above predicate(color_chunk_list) can be turned into clp constraint
with propia mechanism and can genarate clp propagation.
If I have two premises as follows:
a -> c (a implies c)
b -> c (b implies c)
and a derived conclusion:
a -> b (a therefore implies b),
then the conclusion can be shown to be invalid because:
a -> c is valid for statement #1 when a is true and c is true, and
b -> c is valid for statement #2 when b is false and c is true. This leads to a -> b when a is true and b is false, a direct contradiction of statement #3.
Or, per proof with a truth table that contains a line for where the premises are true but the conclusion is false:
Truth Table with true premises and false conclusion
My question is: "Is there a way to use prolog to show that the assertions of statements #1 and #2 contradict the conclusion of statement #3? If so, what is a clear and concise way to do so?"
#coder has already given a very good answer, using clpb constraints.
I would like to show a slightly different way to show that the conclusion does not follow from the premises, also using CLP(B).
The main difference is that I post individual sat/1 constraints for each of the premises, and then use taut/2 to see whether the conclusion follows from the premises.
The first premise is:
a → c
In CLP(B), you can express this as:
sat(A =< C)
The second premise, i.e., b → c, becomes:
sat(B =< C)
If the a → b followed from these premises, then taut/2 would succeed with T = 1 in:
?- sat(A =< C), sat(B =< C), taut(A =< B, T).
false.
Since it doesn't, we know that the conclusion does not follow from the premises.
We can ask CLP(B) to show a counterexample, i.e., an assignment of truth values to variables where a → c and b → c both hold, and a → b does not hold:
?- sat(A =< C), sat(B =< C), sat(~(A =< B)).
A = C, C = 1,
B = 0.
Simply posting the constraints suffices to show the unique counterexample that exists in this case. If the counterexample were not unique, we could use labeling/1 to produce ground instances, for example: labeling([A,B,C]).
For comparison, consider for example:
?- sat(A =< B), sat(B =< C), taut(A =< C, T).
T = 1,
sat(A=:=A*B),
sat(B=:=B*C).
This shows that a → c follows from a → b ∧ b → c.
You could use library(clpb):
Firstly assign to a variable Expr your expression:
Expr = ((A + ~C)*(B + ~C)+(~(A + ~B)).
Note that:
'+' stands for logical OR
'*' for logical AND
'~' for logical NOT
Also A->B is equivalent with A+(~B). So the above expression is equivalent with ((A->C),(B->C))-> (A->C) where we wrote '->' using +,~ and ',' with *.
Now if we query:
?- use_module(library(clpb)).
true.
?- Expr=((A + ~C)*(B + ~C))+(~(A + ~B)),taut(Expr,T).
false.
Predicate taut/2 takes as input an clpb Expression and returns T=1 if it tautology, T=0 if expression cannot be satisfied and fails in any other case. So the fact that the above query failed means that Expr was nor a tautology neither could not be satisfied, it meant that it could be satisfied.
Also by querying:
?- Expr=((A + ~C)*(B + ~C))+(~(A + ~B)),sat(Expr).
Expr = (A+ ~C)* (B+ ~C)+ ~ (A+ ~B),
sat(1#C#C*B),
sat(A=:=A).
Predicate sat/1 returns True iff the Boolean expression is satisfiable and gives the answer that the above Expression is satisfiable when:
sat(1#C#C*B),
sat(A=:=A).
where '#' is the exclusive OR which means that your expression (we know from taut/2 that is satisfiable) is satisfied when 1#C#C*B is satisfied.
Another solution without using libraries could be:
truth(X):-member(X,[true,false]).
test_truth(A,B,C):-
truth(A),
truth(B),
truth(C),
((A->C),(B->C)->(A->C)).
Example:
?- test_truth(A,B,C).
A = B, B = C, C = true ;
false.
Also if I understood correctly from your comment, to collect all possible solutions you could write:
?- findall([A,B,C],test_truth(A,B,C),L).
L = [[true, true, true]].
Which gives a list of lists, where the inner lists have the form [true,true,true] in the above example which means a solution is A=true,B=true,C=true and in the above case it has only one solution.
To find all contradictions you could write:
truth(X):-member(X,[true,false]).
test_truth(A,B,C):-
truth(A),
truth(B),
truth(C),
not( (\+ ((\+A; C),(\+B ; C)) ; (\+A ; B)) ).
last line could also been written as:
not( ( (A->C;true),(B->C;true) ) -> (A->B;true) ;true ).
Example:
?- findall([A,B,C],test_truth(A,B,C),L).
L = [[true, false, true]].
Let's say i have the following predicate:
func1(X,B,R)
I provide it with a certain X and B and in return it gives me 5 different results for R.
EDIT:
The X and B do not specify a range. rather, X specify an integer (say 120) and B specifies all integers (starting from 1) whose cubic is less than X.
What func1 does is calculating R as the result the remainder.
In this case where X=120:
B = 1, R = 119 (120-1^3)
B = 2, R = 112 (120-2^3)
B = 3, R = 93 (120-3^3)
B = 4, R = 56 (120-4^3)
It would not calculate B=5 since 5^3 = 125 which is greater than 120, so it stops here.
How can i make a predicate such as:
func2(R,S)
That would accept all of the results given by R, sum them up and store them in S?
Thanks!
To start with, since the values of B are totally derivable from the value of X, I wouldn't include both as arguments in func1. I'll introduce a predicate func3/2 which is true if the second argument is derivable from the first (i.e., func3(X, B) is true if B is derivable from X):
func1(X, R) :-
func3(X, B),
...
What will happen if you query func1(120, R) is you'd get one or more results for R. Then you can use findall/3 as I indicated in my comment:
func2(X, S) :-
findall(R, func1(X, R), Rs),
sumlist(Rs, S).
To define func3/2 the cleanest approach would be to use CLP(FD):
:- use_module(library(clpfd)).
func3(X, B) :-
B #>= 0,
(X - B^3) #>= 0,
label([B]).
Here's an example of what func3 does:
?- func3(120, B).
B = 1 ;
B = 2 ;
B = 3 ;
B = 4.
A much less desirable way to do this if you can't use CLP(FD) would be to use between and define the upper limit of B to be the greatest integer not exceeding the cube root of X:
func3(X, B) :-
Limit is floor(exp(log(X) / 3)),
between(1, Limit, B).
Which yields the same result as above.
While attempting to learn Prolog I came across a good exercise which was to write a program that displays the Nth Fibonacci number. After some work I got it working and then decided to see if I could write a program that displays a range of Fibonacci numbers according to the input.
For instance the input:
?- fib_sequence(2,5,Output).
Gives the output:
?- Output = [1,1,2,3]
I am having difficulty, however, in finding a good starting point. This is what I have so far:
fib(0, 0).
fib(1, 1).
fib(N, F) :- X is N - 1, Y is N - 2, fib(X, A), fib(Y, B), F is A + B.
fib_sequence(A,B,R) :- fib(A,Y) , fib(B,Z).
I know I must assign a value to R, but I'm not sure how to assign multiple values. Any help is greatly appreciated.
Observe that your fib_sequence cannot be done in a single predicate clause: you need at least two to keep things recursive - one to produce an empty list when A is greater than B (i.e. we've exhausted the range from A to B), and another one to prepend X from fib(A,X) to a list that you are building, increment A by 1, and call fib_sequence recursively to produce the rest of the sequence.
The first predicate clause would look like this:
fib_sequence(A,B,[]) :- A > B.
The second predicate clause is a bit harder:
fib_sequence(A,B,[H|T]) :-
A =< B /* Make sure A is less than or equal to B */
, fib(A, H) /* Produce the head value from fib(A,...) */
, AA is A + 1 /* Produce A+1 */
, fib_sequence(AA, B, T). /* Produce the rest of the list */
Prolog has some helper builtin to handle numeric sequences, then as an alternative to dasblinkenlight' answer, here is an idiomatic 'query':
fib_sequence(First, Last, Seq) :-
findall(F, (between(First,Last,N), fib(N,F)), Seq).
note that it will not work out-of-the-box with your fib/2, because there is a bug: I've added a condition that avoid the endless loop you would experience trying to backtrack on fib/2 solutions:
fib(N, F) :- N > 1, % added sanity check
X is N - 1, Y is N - 2, fib(X, A), fib(Y, B), F is A + B.
Here's yet another approach. First, I redid fib a little so that it only recursively calls itself once instead of twice. To do this, I created a predicate that returns the prior the last two Fibonacci values instead of the last one:
fib(N, F) :-
fib(N, F, _).
fib(N, F, F1) :-
N > 2,
N1 is N-1,
fib(N1, F1, F0),
F is F0 + F1.
fib(1, 1, 0).
fib(2, 1, 1).
For getting the sequence, I chose an algorithm with the Fibonacci calculation built-in so that it doesn't need to call fib O(n^2) times. It does, however, need to reverse the list when complete:
fib_sequence(A, B, FS) :-
fib_seq_(A, B, FSR),
reverse(FSR, FS).
fib_sequence_(A, B, []) :-
A > B.
fib_sequence_(A, B, [F]) :-
A =:= B,
fib(A, F, _).
fib_sequence_(A, B, [F1,F0]) :-
1 is B - A,
fib(B, F1, F0).
fib_sequence_(A, B, [F2,F1,F0|FT] ) :-
B > A,
B1 is B - 1,
fib_sequence_(A, B1, [F1,F0|FT]),
F2 is F1 + F0.
Here's one more way, to do it without the reverse, but the reverse method above still appears to be a little faster in execution.
fib_sequence_dl(A, B, F) :-
fib_sequence_dl_(A, B, F, [_,_|[]]).
fib_sequence_dl_(A, B, [], _) :-
A > B, !.
fib_sequence_dl_(A, B, [F], _) :-
A =:= B,
fib(A, F, _), !.
fib_sequence_dl_(A, B, [F0,F1|T], [F0,F1|T]) :-
1 is B - A,
fib(B, F1, F0), !.
fib_sequence_dl_(A, B, F, [F1,F2|T]) :-
A < B,
B1 is B - 1,
fib_sequence_dl_(A, B1, F, [F0,F1|[F2|T]]),
F2 is F0 + F1.