Prolog Permutations - algorithm

I'm trying to get more into learning prolog as I'll be taking an AI class at school next semester. I've been able to get down the basics down and can do relation based stuff, however, I've been trying to learn permutations and combinatronics and they seem pretty straightforward, but it led me to a question that I can't figure out how to solve. Say I wanted to know the permutations of 1's and 0's with a certain condition that there must be atleast 4 1's in a row.
I have no idea where I would start to try and find a solution for this, but in the end I want the code to do something like this:
?- placeOnesAndZeros(9,X).
% where 9 is the length of the list/array and X is the permutations
[0,0,0,0,0,0,0,0,0]
[1,1,1,1,0,0,0,0,0]
[0,1,1,1,1,0,0,0,0]
[0,0,1,1,1,1,0,0,0]
[0,0,0,1,1,1,1,0,0]
[0,0,0,0,1,1,1,1,0]
[0,0,0,0,0,1,1,1,1]
[1,1,1,1,0,1,1,1,1]
[1,1,1,1,1,0,0,0,0]
[0,1,1,1,1,1,0,0,0]
[0,0,1,1,1,1,1,0,0]
[0,0,0,1,1,1,1,1,0]
[0,0,0,0,1,1,1,1,1]
[1,1,1,1,1,1,0,0,0]
[0,1,1,1,1,1,1,0,0]
[0,0,1,1,1,1,1,1,0]
[0,0,0,1,1,1,1,1,1]
[1,1,1,1,1,1,1,0,0]
[0,1,1,1,1,1,1,1,0]
[0,0,1,1,1,1,1,1,1]
[1,1,1,1,1,1,1,1,0]
[0,1,1,1,1,1,1,1,1]
[1,1,1,1,1,1,1,1,1]
Thank you in advance!
EDIT CODE:
printList([ ]).
printList([H|T]) :- print(H), nl, printList(T).
eval([],_).
eval([H|T],[1,0]):-member(H,[1,0]),eval(T,[1,0]).
placeOnesAndZeros(N, L):-length(L,N), eval(L,[1,0]).

Generate and test it's the name of the basic technique used to search a solution space. In Prolog, it's practically built in. Just provide a filter discarding what is not required:
?- placeOnesAndZeros(9,L),once(append(_,[1,1,1,1|_],L)).
once/1 is required, otherwise append/3 could succeed multiple times.
To check the correctness of the approach, here is how to count how many solutions we get:
?- aggregate(count,L^H^T^(placeOnesAndZeros(9,L),once(append(H,[1,1,1,1|T],L))),C).
C = 111.
The quantification on variables L,H,T (these last 2 being introduced only to aggregate) can be avoided using aggregate_all:
?- aggregate_all(count,(placeOnesAndZeros(9,L),once(append(_,[1,1,1,1|_],L))),C).
C = 111.
edit
As #lurker noted, my filter isn't correct. Try instead
atLeastFourOnes(L) :- memberchk(1,L), atLeastFourOnes_(L).
atLeastFourOnes_([]).
atLeastFourOnes_([0|L]) :- atLeastFourOnes_(L).
atLeastFourOnes_([1,1,1,1|L]) :- stripOnes(L,R), atLeastFourOnes_(R).
that yields
?- placeOnesAndZeros(9,L),atLeastFourOnes(L).
L = [1, 1, 1, 1, 1, 1, 1, 1, 1] ;
L = [1, 1, 1, 1, 1, 1, 1, 1, 0] ;
L = [1, 1, 1, 1, 1, 1, 1, 0, 0] ;
...
?- aggregate(count,L^(placeOnesAndZeros(9,L),atLeastFourOnes(L)),C).
C = 22.

Related

Prolog: random permutation

I'm trying to get random permutation with prolog. But the problem is
?- permutation([1,2,3,4],L).
gives always L = [1, 2, 3, 4] as first answer. I could fix this by using the query
?- L1=[1,2,3,4], permutation(L1,L2), dif(L1,L2).
But this gives me always L2 = [1, 2, 4, 3] as first answer.
How can I get a random permutation in SWI Prolog?
Isn't [1,2,3,4] random enough? Looks random to me!
But I know what you mean - you want a permutation which looks more random.
Why not roll your own? Just pick the next element out of an ever-shrinking "input list".
This is a bit laborious. Maybe there are more elegant ways?
look_random_dammit([],[]) :- !.
% note that [PickedElement|PermutedList] APPENDS "PickedElement"
% to list being constructed. Appending or prepending does not
% really make a difference here though:
look_random_dammit(ListRemainder,[PickedElement|PermutedList]) :-
ListRemainder \== [],
length(ListRemainder,Length),
succ(Max,Length),
% We are now leaving logicland and asking an oracle to give
% use a random number. "Buckle your seatbelt Dorothy, 'cause
% Kansas is going bye-bye!"
random_between(0,Max,PickedIndex),
nth0(PickedIndex,ListRemainder,PickedElement),
length(Prefix,PickedIndex),
% Constructing a remainder list is probably slow
append([Prefix,[PickedElement],Suffix],ListRemainder) ,
append(Prefix,Suffix,ListRemainderNext),
look_random_dammit(ListRemainderNext,PermutedList).
And so:
?- look_random_dammit([1,2,3,4],P).
P = [2,3,1,4] ;
false.
?- look_random_dammit([],P).
P = [] ;
false.
?- look_random_dammit([1,1,1,2,2],P).
P = [2,1,1,2,1] ;
false.
If we also retained the information about which elements was picked in equence, we could write a predicate that "reverses the permutation" because no information was lost while creating it.
You can try:
?- random_permutation([1,2,3,4], P).
P = [2, 1, 4, 3].
I am just giving an alternate method.
Using findall to get all possible permutations.
Getting the length of the List containing the permutations.
Using random to generate a random number between 0 and the length. This will be used as an index value.
Using nth1 to give us a permutation on the given index.
! (Cut) is used to give only one value. if you want more values then remove it.
Example:-
perm([H|T],Permutation):-
findall(A,permutation([H|T],A),List),
length(List,Length),
random(1,Length,Random),
nth1(Random,List,Permutation),!.
?- perm([1,2,3,4],Permutation).
Permutation = [1, 4, 3, 2]
?- perm([1,2,3,4],Permutation).
Permutation = [3, 1, 2, 4]
?- perm([1,2,3,4],Permutation).
Permutation = [3, 1, 4, 2]

Prolog: obtain a list with two sublists, containing the odd position elements and the even position elements. How to Improve this code

I would like to ask, if anyone knows how to improve (if it's not optimal) this code.
The idea, is that you have a list of elements, and I want to return a list, with two sublists inside it, the first sublist should contain the elements that are contained in the odd positions of the list, and the second sublist should contain, the elements that are contained in the even positions of the list.
Some examples:
?-evenAndOdd([1,2,3,4,5],[[1,3,5],[2,4]])
True.
?-evenAndOdd([a,b,c,d,e],[[a,c,e],[b,d]]).
True.
The code I have implemented is the next one:
evenAndOdd([],[]).
evenAndOdd([H|R],NL):-
evenAndOddRec([H|R], [[],[]],1,NL).
evenAndOddRec([], [LOdd,LEven],_,[LOdd,LEven]).
evenAndOddRec([H|R],[LOdd,LEven],Pos,NL):-
\+ even(Pos),
!,
NPos is Pos +1,
append(LOdd,[H],NLOdd),
evenAndOddRec(R,[NLOdd,LEven],NPos,NL).
evenAndOddRec([H|R],[LOdd,LEven],Pos,NL):-
NPos is Pos + 1,
append(LEven, [H], NLEven),
evenAndOddRec(R,[LOdd, NLEven],NPos,NL).
even(N):-
N mod 2 =:=0.
One symptom that the code is not optimal is that it will run off into the woods if you ask for an additional solution in the -,+,+ instantiation pattern:
?- evenAndOdd(X, [[1,3,5], [2,4,6]]).
X = [1, 2, 3, 4, 5, 6] ;
<time passes>
This kind of thing is a frequent occurrence when manually trying to match up lists with indexes in Prolog.
Stylistically, I would rather not give back a list containing exactly two lists when I could just have three arguments instead of two; this is, after all, a relationship between three lists, the combined list and the even and odd items.
Additionally, just eyeballing it, I'm not sure why any arithmetic or any cuts are needed here. This is how I would implement it:
evenAndOdd([], [], []).
evenAndOdd([O], [O], []).
evenAndOdd([O,E|Rest], [O|ORest], [E|ERest]) :- evenAndOdd(Rest, ORest, ERest).
This works with many instantiations:
?- evenAndOdd([1,2,3,4,5,6], O, E).
O = [1, 3, 5],
E = [2, 4, 6].
?- evenAndOdd([1,2,3,4,5], O, E).
O = [1, 3, 5],
E = [2, 4] ;
false.
?- evenAndOdd(X, [1,3,5], [2,4]).
X = [1, 2, 3, 4, 5] ;
false.
?- evenAndOdd(X, [1,3,5], [2,4,6]).
X = [1, 2, 3, 4, 5, 6].
?- evenAndOdd(X, [1,3,5], [2,4,6,8]).
false.
?- evenAndOdd([1,2,3,4,5,6], X, [2,4,6,8]).
false.
?- evenAndOdd([1,2,3,4,5,6], X, [2,4,6]).
X = [1, 3, 5].
You can implicitly determine even and odd values upon recursion, by taking two elements at a time (and taking into account when the has an odd number of elements):
evenAndOdd(L, [LOdd, LEven]):-
evenAndOdd(L, LOdd, LEven).
evenAndOdd([], [], []).
evenAndOdd([Odd], [Odd], []).
evenAndOdd([Odd,Even|Tail], [Odd|LOdd], [Even|LEven]):-
evenAndOdd(Tail, LOdd, LEven).

Non-destructive universal quantification in Prolog

A good language for logic programming should allow the programmer to use a language close to the language used by the mathematicians. Therefore, I have always considered the lack of proper universal quantifier in Prolog an important shortcoming.
Today an idea came to me how to define something much better than forall and foreach.
forany(Var, {Context}, Condition, Body)
This predicate tries to prove Body for all instantiations Var gets successively on backtracking over Condition. All variables in Condition and Body are considered local unless listed in Var or Context. Condition is not permitted to modify in any way the variables listed in Context, otherwise forany won't work correctly.
Here is the implementation (based on yall):
forany(V, {Vars}, Goal1, Goal2) :-
( bagof(V, {V,Vars}/Goal1, Solutions)
-> maplist({Vars}/[V]>>Goal2, Solutions)
; true ).
My first question is about the second argument of forany. I'd like to eliminate it.
Now some examples
Construct a list of the first 8 squares:
?- length(X,8), forany(N, {X}, between(1,8,N),
(Q is N*N, nth1(N, X, Q))).
X = [1, 4, 9, 16, 25, 36, 49, 64].
Reverse a list:
?- X=[1,2,3,4,5], length(X,N), length(Y,N),
forany(I, {X,Y,N}, between(1,N,I),
(J is N-I+1, nth1(I,X,A), nth1(J,Y,A))).
X = [1, 2, 3, 4, 5],
N = 5,
Y = [5, 4, 3, 2, 1].
Subset:
subset(X, Y) :- forany(A, {X,Y}, member(A,X), member(A, Y)).
A funny way to generate all permutations of a list without duplicates:
permutation(X, Y) :-
length(X, N), length(Y, N), subset(X, Y).
?- permutation([1,2,3],X).
X = [1, 2, 3] ;
X = [1, 3, 2] ;
X = [2, 1, 3] ;
X = [2, 3, 1] ;
X = [3, 1, 2] ;
X = [3, 2, 1] ;
false.
A funny way to sort a list of different integers. Notice that constraints are used to make the list sorted so most permutations won't be generated:
sorted(X) :- forany(A-B, {X}, append(_, [A,B|_], X),
A#<B).
?- X=[7,3,8,2,6,4,9,5,1], length(X, N), length(Y, N),
sorted(Y), subset(X,Y).
X = [7, 3, 8, 2, 6, 4, 9, 5, 1],
N = 9,
Y = [1, 2, 3, 4, 5, 6, 7, 8, 9] .
The problem
It seems that this forany works brilliantly when constraints are not used. Also, it can be used to generate constraints, but at least on SWI-Prolog there are problems when constraints already have been generated. The reason for this is that forany uses bagof and according to the manual of SWI-Prolog:
Term-copying operations (assertz/1, retract/1, findall/3, copy_term/2, etc.) generally also copy constraints. The effect varies from ok, silent copying of huge constraint networks to violations of the internal consistency of constraint networks. As a rule of thumb, copying terms holding attributes must be deprecated. If you need to reason about a term that is involved in constraints, use copy_term/3 to obtain the constraints as Prolog goals, and use these goals for further processing.
Here is a demonstration of the problem bagof creates with constraints:
?- X=[A,B,C], dif(C,D), bagof(_, K^member(K,X), _).
X = [A, B, C],
dif(C, _5306),
dif(C, _5318),
dif(C, _5330),
dif(C, D).
As you can see, three unnecessary constraints are created.
My second question is if this is a problem only of SWI-Prolog.
And the third question: is there a way to fix this in SWI-Prolog. The above quote from the manual suggests that copy_term/3 should be used. Unfortunately, I don't understand this suggestion and I don't know if it is useful for forany.
Great news! I was surprised that bagof is written in Prolog. By looking at its code I learned that some things I thought are impossible are in fact possible. And just as the manual of SWI-Prolog suggested, copy_term/3 or rather the similar predicate copy_term_nat/2 helped.
So with great joy I am able to present a fully working (as far as I can tell) universal quantifier for SWI-Prolog:
forany(V, {Vars}, Condition, Body) :-
findall(V-Vars, Condition, Solutions),
% For SWI-Prolog. Can be replaced by Solutions=Clean_solutions in other systems
copy_term_nat(Solutions, Clean_solutions),
forany_execute_goals(Clean_solutions, Vars, V, Body).
forany_execute_goals([], _, _, _).
forany_execute_goals([Sol-NewVars|Solutions], Vars, V, Body) :-
% The following test can be removed
assertion(subsumes_term(NewVars, Vars)),
% or replaced by the following more standard use of throw/1:
% ( subsumes_term(NewVars, Vars)
% -> true
% ; throw('Forbidden instantiation of context variables by the antecedent of forany') ),
NewVars = Vars,
call({Vars}/[V]>>Body, Sol),
forany_execute_goals(Solutions, Vars, V, Body).

Prolog list of list n number with condition

I'm studying prolog language and i have an issue regarding this problem.
I've already created a program that, given a number N, returns a list with elements between 0 and N:
list2val(N,L):- list2val(0,N,L).
list2val(N,N,[N]).
list2val(C,N,[C|T]):-
C<N,
N1 is C+1,
list2val(N1,N,T).
?- list2val(5,X).
X = [0,1,2,3,4,5]
Now i'm trying to give an extension that, given a list, returns a list of lists in which every list is list2val only if the next number is greater than current number. In this case:
?- newFuction([1,5,2,3,9],L).
L = [[0,1],[0,1,2,],[0,1,2,3]]
My code is this, but somethings is wrong:
array(X):- array(X,_L).
array([],_L).
array([H|[T|Ts]],L1):-
H<T,
list2val(H,L2),
array([T|Ts],[L1|[L2]]).
array([T|Ts],L1).
Maybe could be too much difficult to understand but using a list L = [1,5,2,3,9] i do those steps:
check 1<5 so i create a 1 list2val until 1..in this case [0,1]
check 5<2 i dont create nothing.
check 2<3 i create list2val of 2 ...[0,1,2]
and so on...
I don't want use a standard predicates, by implement with standard terms.
A solution for your problem could be:
list2val(N,L):- list2val(0,N,L).
list2val(N,N,[N]):- !.
list2val(C,N,[C|T]):-
C<N,
N1 is C+1,
list2val(N1,N,T).
simulate([_],[]).
simulate([A,B|T],[H|T1]):-
( A < B ->
list2val(A,H),
simulate([B|T],T1);
simulate([B|T],[H|T1])
).
Using a predicate like simulate/2, you can solve your problem: it compares two numbers of the list and then create a new list in case the condition is satisfied.
?- simulate([1,5,2,3,9],LO).
LO = [[0, 1], [0, 1, 2], [0, 1, 2, 3]]
false

Define the predicate Prolog

I'm reviewing some exercise for the coming test and having difficulty at this.
Given a list of integers L, define the predicate: add(L,S) which returns a list of integers S in which each element is the sum of all the elements in L up to the same position.
Example:
?- add([1,2,3,4,5],S).
S = [1,3,6,10,15].
So my question is what define the predicate means? It looks pretty general. I've read some threads but they did not provide much. Thanks!
This is a good exercise to familiarize yourself with two important Prolog concepts:
declarative integer arithmetic to reason about integers in all directions
meta-predicates to shorten your code.
We start with a very simple relation, relating an integer I and a sum of integers S0 to a new sum S:
sum_(I, S0, S) :- S #= S0 + I.
Depending on your Prolog system, you may need a directive like:
:- use_module(library(clpfd)).
to use declarative integer arithmetic.
Second, there is a powerful family of meta-predicates (see meta-predicate) called scanl/N, which are described in Richard O'Keefe's Prolog library proposal, and already implemented in some systems. In our case, we only need scanl/4.
Example query:
?- scanl(sum_, [1,2,3,4,5], 0, Sums).
Sums = [0, 1, 3, 6, 10, 15].
Done!
In fact, more than done, because we can use this in all directions, for example:
?- scanl(sum_, Is, 0, Sums).
Is = [],
Sums = [0] ;
Is = [_2540],
Sums = [0, _2540],
_2540 in inf..sup ;
Is = [_3008, _3014],
Sums = [0, _3008, _3044],
_3008+_3014#=_3044 ;
etc.
This is what we expect from a truly relational solution!
Note also the occurrence of 0 as the first element in the list of partial sums. It satisfies your textual description of the task, but not the example you posted. I leave aligning these as an exercise.
Define the predicate simply means write a predicate that does what the question requires.
In your question you have to write the definition of add/2 predicate( "/2" means that it has two arguments). You could write the definition below:
add(L,S):- add1(L,0,S).
add1([],_,[]).
add1([H|T],Sum,[H1|T1]):- H1 is Sum+H,NSum is Sum+H,add1(T,NSum,T1).
The above predicate gives you the desired output. A simple example:
?- add([1,2,3,4,5],S).
S = [1, 3, 6, 10, 15].
I think the above or something similar predicate is what someone would wait to see in a test.
Some additional information-issues
The problem with the predicate above is that if you query for example:
?- add(S,L).
S = L, L = [] ;
ERROR: is/2: Arguments are not sufficiently instantiated
As you see when you try to ask when your predicate succeeds it gives an obvious solutions and for further solutions it throws an error. This is not a very good-desired property. You could improve that by using module CLPFD:
:- use_module(library(clpfd)).
add(L,S):- add1(L,0,S).
add1([],_,[]).
add1([H|T],Sum,[H1|T1]):- H1 #= Sum+H,NSum #= Sum+H,add1(T,NSum,T1).
Now some querying:
?- add([1,2,3,4,5],S).
S = [1, 3, 6, 10, 15].
?- add(S,[1,3,6]).
S = [1, 2, 3].
?- add(S,L).
S = L, L = [] ;
S = L, L = [_G1007],
_G1007 in inf..sup ;
S = [_G1282, _G1285],
L = [_G1282, _G1297],
_G1282+_G1285#=_G1307,
_G1282+_G1285#=_G1297 ;
...and goes on..
As you can see now the predicate is in the position to give any information you ask! That's because now it has a more relational behavior instead of the functional behavior that it had before due to is/2 predicate. (These are some more information to improve the predicate's behavior. For the test you might not be allowed to use libraries etc... so you may write just a simple solution that at least answers the question).

Resources