Using Sicstus and given the list
[b > f, f > c, c > b, g > h, g > g, d, b, f > k, k > f, f > c]
I want to transform it to:
graph([b,c,d,f,g,h,k],[e(b,f),e(c,b),e(f,c),e(f,k),e(g,g),e(g,h),e(k,f)])
My goal is to transform the first list to the two separate lists by only one pass through the former and the usage of two accumulators.
hf_to_graph_term([H|T], AccN, Nodes, AccE, Edges):-
H = A>B,!,
merge([H],AccE,NewAccE),
hf_to_graph_term(T,AccN,Nodes,NewAccE,Edges).
However, I get the error message:
! Syntax error
! operator expected after expression
! in line 290
! hf_to_graph_term ( [ H | T ] , AccN , Nodes , AccE , Edges ) :- H = A
! <<here>>
! > B , ! ,
This is because > is reserved as comparison operator.
Which changes do I have to make in my code?
This is in fact a priority clash: for the interpreter it is not clear how it should read H = A > B, as H = (A > B), or (H = A) > B?
The solution is to make this explicit, and use brackets. You can rewrite the predicate to:
hf_to_graph_term([H|T], AccN, Nodes, AccE, Edges):-
H = (A > B),
!,
merge([H],AccE,NewAccE),
hf_to_graph_term(T,AccN,Nodes,NewAccE,Edges).
or you can do this in a more canonical form:
hf_to_graph_term([H|T], AccN, Nodes, AccE, Edges):-
H = >(A, B),
!,
merge([H],AccE,NewAccE),
hf_to_graph_term(T,AccN,Nodes,NewAccE,Edges).
Since here you do not seem to use A or B, we can also use underscores:
hf_to_graph_term([H|T], AccN, Nodes, AccE, Edges):-
H = >(_, _),
!,
merge([H],AccE,NewAccE),
hf_to_graph_term(T,AccN,Nodes,NewAccE,Edges).
Related
Having a list with independent variables, whose domain is 1..N, how can we use labeling/2 so it starts producing solutions starting from the middle?
The flags i tried are [bisect], [enum], [max], [min], [ff], but no matter which i picked, i can't make it work.
My code is:
:-use_module(library(clpfd)).
combos(EMPLOYEES,POSTS,LIST):-
LIMIT is POSTS-EMPLOYEES+1,
length(LIST,EMPLOYEES),
LIST ins 1..LIMIT,
sum(LIST,#=,POSTS),
labeling([bisect],LIST).
after setting a query, for example:
?-combos(2,10,LIST).
i want it to return:
L = [5,5];
L = [4,6];
L = [6,4] ...
instead of:
L = [1,9];
L = [2,8];
L = [3,7] ...
As a rule of thumb, whenever you try to extend the functionality of clpfd, try to reuse as much as possible. It seems that you want solutions first whose sum of distances to the center is as small as possible.
combos2(EMPLOYEES,POSTS,LIST):-
LIMIT is POSTS-EMPLOYEES+1,
length(LIST,EMPLOYEES),
LIST ins 1..LIMIT,
sum(LIST,#=,POSTS),
Mid is (LIMIT+1) div 2, %%
maplist(dist(Mid), LIST, DISTS), %%
sum(DISTS,#=,Totaldist), %%
labeling([],[Totaldist|LIST]).
dist(Mid, E, D) :-
D #= abs(Mid-E).
?- combos2(2,10,L).
L = [5,5]
; L = [4,6]
; L = [6,4]
; L = [3,7]
; L = [7,3]
; ... .
Here you go!
combos(2,S,L) :- b2(S,L).
combos(C,S,[A|L]) :-
C > 2,
b2(S,[A,B]),
D is C-1,
combos(D,B,L).
b2(S,L) :- B is S-1, bisector(B,L).
bisector(Y,[A,B]) :-
odd(Y),
M is div(1+Y,2),
Z is M-1,
range(D,0,Z),
bisec1(D,M,A,B).
bisector(Y,[A,B]) :-
even(Y),
M is 1+Y,
Z is Y/2-1,
range(D,0,Z),
bisec2(D,M,A,B).
bisec1(0,M,M,M).
bisec1(D,M,A,B) :- D > 0, A is M + D, A > 0, B is M - D, B > 0.
bisec1(D,M,A,B) :- D > 0, A is M - D, A > 0, B is M + D, B > 0.
bisec2(D,M,A,B) :- A is (M+2*D+1)/2, A > 0, B is (M-2*D-1)/2, B > 0.
bisec2(D,M,A,B) :- A is (M-2*D-1)/2, A > 0, B is (M+2*D+1)/2, B > 0.
even(X) :- 0 is mod(X, 2).
odd(X) :- 1 is mod(X, 2).
range(M,M,_).
range(X,M,N) :- P is M + 1, P =< N, range(X,P,N).
These are predicates which reads from input file
read_line(L,C) :-
get_char(C),
(isEOFEOL(C), L = [], !;
read_line(LL,_),% atom_codes(C,[Cd]),
[C|LL] = L).
%Tests if character is EOF or LF.
isEOFEOL(C) :-
C == end_of_file;
(char_code(C,Code), Code==10).
read_lines(Ls) :-
read_line(L,C),
( C == end_of_file, Ls = [] ;
read_lines(LLs), Ls = [L|LLs]
).
Input file:
A B
C D
E F
G H
read_lines(L) returns L = [[A, ,B],[C, ,D],[E, ,F],[G, ,H]]. My goal is to replace all the spaces and merge list of lists into single list. So expected output should look like: L = [A-B,C-D,E-F,G-H].
What I got so far is modified read_line function:
read_line(L,C) :-
get_char(C),
( (char_code(C,Code), Code == 32)
-> C = '-'
; C = C),
(isEOFEOL(C), L = [], !;
read_line(LL,_),% atom_codes(C,[Cd]),
[C|LL] = L).
When I use it, Prolog says Syntax error: Unexpected end of file. What's wrong with that?
The problem is in this code:
( (char_code(C,Code), Code == 32)
-> C = '-'
; C = C),
If a space character was read into variable C, char_code binds Code to 32, and the condition is true. Then Prolog tries to unify C with '-', but C is already bound to ' '! This fails, so your read_line call fails and leaves some unconsumed input on the standard input stream. The next time Prolog tries to read input from you, it actually reads that remaining input.
The underlying cause of the problem is that you seem to be trying to "reassign" the variable C. That is not possible in Prolog; once a variable is bound, it can only become unbound on backtracking.
Use a new variable, something like this:
( (char_code(C,Code), Code == 32)
-> NewC = '-'
; NewC = C),
with corresponding uses of NewC where appropriate.
Here is my problem:
etp(V W,[V W|G]).
etp(W V,[V W|G]).
etp(V W,[_|G]):- etp(V W,G).
Prolog says Syntax error: Operator expected. I tried to escape the blank symbol like '\s', "\s" and couple other possibilities which I figured out should work. Well, neither did not work properly. What's the right way to escape space character to match e.g.: etp(A B,[A B,C D].
Edit:
List is created in following way:
read_line(L,C) :-
get_char(C),
(isEOFEOL(C), L = [], !;
read_line(LL,_),% atom_codes(C,[Cd]),
[C|LL] = L).
%Tests if character is EOF or LF.
isEOFEOL(C) :-
C == end_of_file;
(char_code(C,Code), Code==10).
read_lines(Ls) :-
read_line(L,C),
( C == end_of_file, Ls = [] ;
read_lines(LLs), Ls = [L|LLs]
).
So it reads a input which looks like
A B
C D
E F
G H
And read_lines(L) returns L = [[A, ,B],[C, ,D],[E, ,F],[G, ,H]].
That's how I get those spaces between them.
Well I actually need to replace the , , by -, which I tried to do:
read_line(L,C) :-
get_char(C),
( (char_code(C,Code), Code == 32)
-> C = '-'
; C = C),
(isEOFEOL(C), L = [], !;
read_line(LL,_),% atom_codes(C,[Cd]),
[C|LL] = L).
And Prolog says Syntax error: Unexpected end of file. Don't know whats wrong.
Given facts:
edges(a,[b,c]).
edges(b,[d]).
edges(c,[a]).
edges(d,[e]).
For now, I can write following predicate:
find(F, L) :-
edges(F, Nodes) ->
findall([X|Y], (member(X, Nodes), find(X, Y)), L);
L = [].
It works fine when there is no cycle, for example, find(b,L). gives me d and e. But it's not working when cycle exists. So how can I modify my code to handle the cycle? e.g find(c,L) will output a, b, c, d, e as well as find(a,L).
Any helps are appreciated.
You could opt to use an accumulator to keep track of the nodes you visited. In order to do this you need a list as an additional argument. Since this lists is empty at the beginning of your search, you'd always call the predicate with [], so you might as well hide it by using a calling predicate, let's maybe call it start_dest/2:
start_dest(S,D) :-
dif(S,D), % start and destination nodes are different
start_dest_(S,D,[]). % actual relation called with empty accumulator
The first goal dif/2 is only necessary in order to prevent solutions where the start node and the destination node are the same. If you want to permit such solutions just remove that goal. The actual relation will search for reachable nodes by traversing the graph node by node. You can distinguish two cases.
If the two nodes are equal you found a possible destination node.
If the nodes are different, there has to be to be an intermediate node in the adjacence list of the node you are currently at. The current node must not have been visited in the search so far (to avoid cycles). There has to be a path from the intermediate node to the destination and the current node must not appear in that path, so it has to be added to the list of visited nodes.
You can express these two cases in Prolog like so:
start_dest_(D,D,_Visited). % case 1: destination found
start_dest_(S,D,Visited) :- % case 2:
maplist(dif(S),Visited), % S has not been visited yet
edges(S,Reachable), % Reachable is the adjacence list
member(X,Reachable), % that has to contain the intermediate node X
start_dest_(X,D,[S|Visited]). % there has to be a path from X to D that
% does not include S
Your example queries yield the desired result:
?- start_dest(b,N).
N = d ;
N = e ;
false.
?- start_dest(c,N).
N = a ;
N = b ;
N = d ;
N = e ;
false.
If you remove the first goal (dif(S,D)) in start_dest/2, you get an additional solution. This corresponds to the view that every node is reachable from itself.
?- start_dest(b,N).
N = b ;
N = d ;
N = e ;
false.
Note that this predicate can be used in all directions, e.g. From which nodes can e be reached?:
?- start_dest(S,e).
S = a ;
S = b ;
S = c ;
S = d ;
false.
Or the most general query: Which nodes are reachable from any node?:
?- start_dest(S,D).
S = a,
D = b ;
S = a,
D = d ;
S = a,
D = e ;
S = a,
D = c ;
S = b,
D = d ;
S = b,
D = e ;
S = c,
D = a ;
S = c,
D = b ;
S = c,
D = d ;
S = c,
D = e ;
S = d,
D = e ;
false.
As opposed to your predicate find/2, start_dest/2 gives you the reachable nodes one at a time. If you want to get all reachable nodes in a list, you can use predicates like findall/3, bagof/3 and setof/3 as you did in find/2, e.g.:
?- bagof(N, start_dest(b,N), Reachable).
Reachable = [d, e].
?- bagof(N, start_dest(c,N), Reachable).
Reachable = [a, b, d, e].
If you intend to always search for all reachable nodes but do not want to query with bagof/3 all the time, you can write a calling predicate like:
reachable_from(Reachable,Start) :-
bagof(N, start_dest(Start,N), Reachable).
?- reachable_from(Reachable,Start).
Reachable = [b, d, e, c],
Start = a ;
Reachable = [d, e],
Start = b ;
Reachable = [a, b, d, e],
Start = c ;
Reachable = [e],
Start = d.
Here is a possibility :
% we get a list of all edges
get_all_edges(Edges) :-
bagof(edges(X,Y), edges(X,Y), Edges).
% main predicate
find(F, L) :-
get_all_edges(Edges),
find(Edges, F, Out),
% the result you get is for example [[a, [b, [d, [e|e], [e]]], [c]]]
flatten(Out, FOut),
list_to_set(FOut, L).
% no more edges, work is done
find([], L, L).
find(Edges, F, L) :-
% we get the good nodes
select(edges(F, Nodes), Edges, Rest)
-> findall([X|Y], (member(X, Nodes), find(Rest, X, Y)), L)
; L = [].
Result :
?- find(c, L).
L = [a, b, d, e, c].
After you'll have learned the basic way, take a look to what libraries have to offer:
?- findall(V-U,(edges(V,Us),member(U,Us)),Es),
vertices_edges_to_ugraph([],Es,G),
reachable(a,G,Rs).
Es = [a-b, a-c, b-d, c-a, d-e],
G = [a-[b, c], b-[d], c-[a], d-[e], e-[]],
Rs = [a, b, c, d, e].
You could be tempted to go directly from your edges/2 to ugraph format, but better make use of predefined functionality (i.e. vertices_edges_to_ugraph/3)
I found this freaking great algorithm in SWI-prolog's source code.
It's so elegant that I want to share it with you.
This snippet is indeed a BFS algorithm.
%! reachable(+Vertex, +UGraph, -Vertices)
%
% True when Vertices is an ordered set of vertices reachable in
% UGraph, including Vertex. Example:
%
% ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
% V = [1, 3, 5]
reachable(N, G, Rs) :-
reachable([N], G, [N], Rs).
reachable([], _, Rs, Rs).
reachable([N|Ns], G, Rs0, RsF) :-
neighbours(N, G, Nei),
ord_union(Rs0, Nei, Rs1, D),
append(Ns, D, Nsi),
reachable(Nsi, G, Rs1, RsF).
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.