Is there always an accumulator to replace append/3? [SOLVED] - prolog

Can append/3 at the end of this code
provable(F, P) :- prove([] > [F], P).
% axiom
prove(G > D, ax(G > D, A)) :- member(A,G), member(B,D), A == B, !.
% implication
prove(G > D, limpl(G > D, P1,P2)) :- select1((A => B),G,G1), !,
prove(G1 > [A|D], P1), prove([B|G1] > D, P2).
prove(G > D, rimpl(G > D, P)) :- select1((A => B),D,D1), !,
prove([A|G] > [B|D1], P).
% negation
prove(G > D, lneg(G > D, P)) :- select1( ~A,G,G1), !,
prove(G1 > [A|D], P).
prove(G > D, rneg(G > D, P)) :- select1(~A ,D,D1), !,
prove([A|G] > D1, P).
% -----------------------------------------------------------------
select1(X,L,L1) :- append(L2,[X|L3],L), append(L2,L3,L1).
% -----------------------------------------------------------------
be replaced by an accumulator? (This code is a part of leanseq.pl a A sequent calculus prover implemented in Prolog, by Jens Otten, and I am surprised by the choice of append, instead of an accumulator, hence my question, because my all my tentatives to replace append failed.)

Related

Exctraction of the Proof from Fitting's leanTap Prolog Prover

Here is the SWI-Prolog code of Fitting's leanTap revisited:
:- use_module(library(lists)).
:- use_module(library(statistics)).
% :- use_module(library(dom)).
% operator definitions (TPTP syntax)
:- op( 500, fy, ~). % negation
:- op(1000, xfy, &). % conjunction
:- op(1100, xfy, '|'). % disjunction
:- op(1110, xfy, =>). % conditional
:- op(1120, xfy, <=>). % biconditional
/*
Next, a classification of formula types,
& instances.
*/
type(X & Y, conj, X, Y).
type(~(X & Y), disj, ~ X, ~ Y).
type(X | Y, disj, X, Y).
type(~(X | Y), conj, ~ X, ~ Y).
type(X => Y, disj, ~ X, Y).
type(~(X => Y), conj, X, ~ Y).
type(X <=> Y, disj, X & Y, ~ X & ~ Y).
type(~(X <=> Y), disj, X & ~ Y, ~ X & Y).
type(~ (~ (X)), doub, X, _).
/*
Now the heart of the matter.
thm(Lambda, Gamma) :-
the sequent Lambda --> Gamma is provable.
*/
thm(Lambda, [Doubleneg | Gamma]) :-
type(Doubleneg, doub, X, _), !,
thm(Lambda, [X | Gamma]).
thm(Lambda, [Beta | Gamma]) :-
type(Beta, disj, Beta1, Beta2), !,
thm(Lambda, [Beta1, Beta2 | Gamma]).
thm(Lambda, [Alpha | Gamma]) :-
type(Alpha, conj, Alpha1, Alpha2), !,
thm(Lambda, [Alpha1 | Gamma]), !,
thm(Lambda, [Alpha2 | Gamma]).
thm([L1|Lambda], [L2|_]) :-
(
L1 = L2, !
;
thm(Lambda, [L2])
).
thm(Lambda, [~ L | Gamma]) :-
thm([L | Lambda], Gamma), !.
thm(Lambda, [L | Gamma]) :-
thm([~ L | Lambda], Gamma), !.
/*
Finally, the driver.
*/
prove(X) :-
time(thm([], [X])).
This code according to Fitting provides a sequent calculus. I have tried to change minimally this code to get a Prolog Print of each proof, with input prove(X, Proof), following the structure of Jen Otten's prover (online here
and here):
% -----------------------------------------------------------------
% leanseq.pl - A sequent calculus prover implemented in Prolog
% -----------------------------------------------------------------
:- use_module(library(lists)).
% operator definitions (TPTP syntax)
:- op( 500, fy, ~). % negation
:- op(1000, xfy, &). % conjunction
:- op(1100, xfy, '|'). % disjunction
:- op(1110, xfy, =>). % implication
% -----------------------------------------------------------------
provable(F, P) :- time(prove([] > [F], P)).
% -----------------------------------------------------------------
% axiom
prove(G > D, ax(G > D, A)) :- member(A,G), member(B,D), A == B, !.
% conjunction
prove(G > D, land(G > D, P) ) :- select1( (A & B) ,G,G1), !,
prove([A , B | G1] > D, P).
prove(G > D, rand(G > D, P1,P2)) :- select1( (A & B) ,D,D1), !,
prove(G > [A|D1], P1), prove(G > [B|D1], P2).
% disjunction
prove(G > D, lor(G > D, P1,P2)) :- select1((A | B),G,G1), !,
prove([A|G1] > D, P1), prove([B|G1] > D, P2).
prove(G > D, ror(G > D, P)) :- select1( (A | B),D,D1), !,
prove(G > [A,B|D1], P ).
% implication
prove(G > D, limpl(G > D, P1,P2)) :- select1((A => B),G,G1), !,
prove(G1 > [A|D], P1), prove([B|G1] > D, P2).
prove(G > D, rimpl(G > D, P)) :- select1((A => B),D,D1), !,
prove([A|G] > [B|D1], P).
% negation
prove(G > D, lneg(G > D, P)) :- select1( ~A,G,G1), !,
prove(G1 > [A|D], P).
prove(G > D, rneg(G > D, P)) :- select1(~A ,D,D1), !,
prove([A|G] > D1, P).
% -----------------------------------------------------------------
select1(X,L,L1) :- append(L2,[X|L3],L), append(L2,L3,L1).
% -----------------------------------------------------------------
For example :
provable((p => p), Proof).
% 22 inferences, 0.000 CPU in 0.000 seconds (95% CPU, 1132503 Lips)
Proof = rimpl([]>[(p=>p)], ax([p]>[p], p))
But all my tentatives to get from Fitting's prover (that is complete) a prover that provides a proof like Proof above have failed. Any help that could put me on the right track would be appreciated.
The Fitting code has some silly placement of cuts,
generating spurious choice points, and an unnecessary
recursion redoing all the pattern matching, instead of
directly using member/2. If you implement it more closely to
the original Wang McCarthy from the LISP 1.5 Manual at
page 44 ff, you get a little bit more speed:
/* Fitting */
?- time((between(1,100,_), test, fail; true)).
% 3,358,200 inferences, 0.297 CPU in 0.295 seconds (101% CPU, 11311832 Lips)
true.
/* Wang McCarthy */
?- time((between(1,100,_), test2, fail; true)).
% 2,802,900 inferences, 0.203 CPU in 0.209 seconds (97% CPU, 13798892 Lips)
true.
To arrive at Wang McCarthy replace this here from Fitting:
/* Fitting */
thm([L1|Lambda], [L2|_]) :-
(
L1 = L2, !
;
thm(Lambda, [L2])
).
thm(Lambda, [~ L | Gamma]) :-
thm([L | Lambda], Gamma), !.
thm(Lambda, [L | Gamma]) :-
thm([~ L | Lambda], Gamma), !.
By this here:
/* Wang McCarthy */
thm2(Lambda, [L|_]) :- member(L, Lambda), !.
thm2(Lambda, [~ L | Gamma]) :- !,
thm2([L | Lambda], Gamma).
thm2(Lambda, [L | Gamma]) :-
thm2([~ L | Lambda], Gamma).
As a test case I was running a collection of
principia mathematica tautologies.
The following solution works smoothly and is very fast, with label for sequent rules corresponding to Fitting's sequent calculus that Fitting calls dirseq :
:- use_module(library(lists)).
:- use_module(library(statistics)).
% :- use_module(library(dom)).
% operator definitions (TPTP syntax)
:- op( 500, fy, ~). % negation
:- op(1000, xfy, &). % conjunction
:- op(1100, xfy, '|'). % disjunction
:- op(1110, xfy, =>). % conditional
:- op(1120, xfy, <=>). % biconditional
/*
Next, a classification of formula types,
& instances.
*/
type((X & Y), conj, X, Y).
type(~((X | Y)), conj, ~ X, ~ Y).
type(~((X => Y)), conj, X, ~ Y).
type((X <=> Y), conj, (~ X | Y), (X | ~ Y)).
type(~((X <=> Y)), conj, (X | Y), (~ X | ~ Y)).
type(~ (~ (X)), doub, X, _).
type((X => Y), disj, ~ X, Y).
type(~((X & Y)), disj, ~ X, ~ Y).
type((X | Y), disj, X, Y).
/*
Now the heart of the matter.
thm(Lambda, Gamma) :-
the sequent Lambda --> Gamma is provable.
*/
thm(Lambda > [Alpha | Gamma], R) :-
type(Alpha, conj, Alpha1, Alpha2), !,
thm(Lambda > [Alpha1 | Gamma],P), !,
thm(Lambda > [Alpha2 | Gamma],Q),
R = alpha(Lambda > [Alpha | Gamma],(P & Q)).
thm(Lambda > [Beta | Gamma], R) :-
type(Beta, disj, Beta1, Beta2), !,
thm(Lambda > [Beta1, Beta2 | Gamma],P),
R = beta(Lambda > [Beta | Gamma], P).
thm(Lambda > [Doubleneg | Gamma], R) :-
type(Doubleneg, doub, X, Gamma), !,
thm(Lambda > [X | Gamma], P),
R = dn(Lambda > [Doubleneg | Gamma], P).
thm(Lambda > [L|Gamma], R) :-
member(L, Lambda), !,
R = ax(Lambda > [L|Gamma], ax).
thm(Lambda > [~ L | Gamma], R) :- !,
thm([L | Lambda] > Gamma, P),
R = duality(Lambda > [~ L | Gamma], P).
thm(Lambda > [L | Gamma], R) :-
thm([~ L | Lambda] > Gamma, P),
R = duality(Lambda > [L | Gamma], P).
/*
Finally, the driver.
*/
provable(X, R) :-
time(thm([] > [X], R)).
Many thanks for the help that I have received !
Interestingly you can easily add look-ahead (forward
checking, unit propagation) to Melvin Fittings prover.
Just take this end-phase:
/* Fitting */
thm([L1|Lambda], [L2|_]) :-
(
L1 = L2, !
;
thm(Lambda, [L2])
).
thm(Lambda, [~ L | Gamma]) :-
thm([L | Lambda], Gamma), !.
thm(Lambda, [L | Gamma]) :-
thm([~ L | Lambda], Gamma), !.
And replace it by this end-phase:
/* Fitting + fCube Simplification */
thm(_, [1 | _)] :- !.
thm(_, [0 | Gamma]) :- !,
thm2(_, Gamma).
thm2(_, [L| Gamma]) :-
opposite2(L, R),
reduce(Gamma, R, Gamma2),
thm2(_, Gamma2).
As can be seen in the above, the list Lambda
is even not anymore used. The predicate reduce/2 is
supposed to partially evaluate the list Gamma, under
the assumption that R is true. Here are some timings
for the test case SYN007+1.014.p:
/* Fitting */
% 12,779,502 inferences, 0.813 CPU in 0.826 seconds (98% CPU, 15728618 Lips)
/* Fitting + fCube Simplification */
% 1,203,958 inferences, 0.109 CPU in 0.098 seconds (112% CPU, 11007616 Lips)

Calculation logic formula models with prolog

Given a CNF logic formula
[[a, b, c], [b, d], [not(d), a]] that is equal to ((a or b or c) and (b or d) and (not d or a)), how do I calculate its models (possible values for its atoms that makes the formula true), using prolog? This is what i've got so far:
A valuation to the formula is a list of terms in the form os val(X,B), where X is an atom, and B is its value (0 or 1).
The relation value(X, Vs, B) is given by
value(X, [val(X, B)|_], B) :− !.
value(X, [_|Ps], B) :− value(X, Ps, B).
and its true whenever B is the value for the atom X in the valuation Vs.
The relation sp(F, Ss), given by
sp([],[]).
sp([F|Fs], Ss) :- setof(A, member(A,F), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss).
and its true whenever Ss is the list of atoms in logic formula F.
The relation valuation(As, Vs), given by
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
that is true whenever Vs is a possible valuation for the list of atoms As.
What I need:
The relation ext(F, Vs, B) that is true whenever F is a formula, Vs is a possible valuation for that formula, and B is the value of the formula applying Vs valuation. For example, the consult
ext([[a], [not(b), c]] , [val(a, 1), val(b, 0), val(c , 1)], B).
should return the value B = 1.
The relation model(F,Vs) that is true whenever the valuation Vs is a model for the formula F.
The relation models(F, Ms) that is true whenever Ms is a list which elements are models for the formula F. I guess we need to use prolog’s setof here.
And, at last, I don't know whats the best implementation of val(X,B) to make it work. I dont know if I should specify val(_,1) and val(_,0) to be true or only val(_,1), what is better knowing the other relations to be implemented?
Not sure to understand exactly what you want but...
First of all, let me try to simplify your code.
1) I think your value/2 should be written as
value(X, [val(X, B) | _], B).
value(X, [_ | Ps], B) :-
value(X, Ps, B).
2) I don't understand the purpose of your sp/2 but seems to me that can be simplified as
sp([], []).
sp([[A] | Fs], [A | Ss]) :-
sp(Fs, Ss).
sp([[A | As] | Fs], [A | Ss]) :-
append(As, Fs, N),
sp(N, Ss).
3) I don't understand the purpose of your valutation/2 but seems to me that can be simplified as
isBool(0).
isBool(1).
valuation([], []).
valuation([A | As], [val(A, B) | Vs]) :-
isBool(B),
valuation(As,Vs).
Now I try to respond to your question
4)
I need [...] The relation ext(F, Vs, B) that is true whenever F
is a formula, Vs is a possible valuation for that formula, and B
is the value of the formula applying Vs valuation
I suppose the following should work [caution: not tested really much]
ext([], _, 1).
ext([[] |_], _, 0).
ext([[X | L1] | L2], Vs, B) :-
value(X, Vs, 0),
ext([L1 | L2], Vs, B).
ext([[not(X) | L1] | L2], Vs, B) :-
value(X, Vs, 1),
ext([L1 | L2], Vs, B).
ext([[X | _] | L], Vs, B) :-
value(X, Vs, 1),
ext(L, Vs, B).
ext([[not(X) | _] | L], Vs, B) :-
value(X, Vs, 0),
ext(L, Vs, B).
5)
I need [...] The relation model(F,Vs) that is true whenever the
valuation Vs is a model for the formula F
What about the following ?
model(F, Vs) :-
ext(F, Vs, _). % or ext(F, Vs, 1)?
6)
I need [...] The relation models(F, Ms) that is true whenever Ms is a
list which elements are models for the formula F
If I understand correctly what do you want, given model/2, models/2 could be written as
models(_, []).
models(F, [Vs | Vl]) :-
model(F, Vs),
models(F, Vl).
7)
I don't know whats the best implementation of val(X,B) to make it
work. I dont know if I should specify val(,1) and val(,0) to be true
or only val(_,1)
Not sure to understand your question.
val/2 can't be true for every value; so you can't impose true val(_,1) and/or val(_,0) because given an atom (a, by example) is true val(a,1) or val(a,0) but ins't true val(X,1) for every X.
Another approach here. Translate to executable Prolog, and reify a specific execution (i.e. a proof with specific symbol bindings):
ext(F, Vs, B) :-
or_list(F, [], C, Vs), !,
assign(Vs), ( call(C), B = true ; B = false ).
assign(Dict) :- maplist(domain, Dict).
domain(val(_, true)).
domain(val(_, false)).
or_list([A], D, T, Du) :-
!, and_list(A, D, T, Du).
or_list([A|As], D, ( T ; Ts ), Du) :-
and_list(A, D, T, Dut),
or_list(As, Dut, Ts, Du).
and_list([V], D, T, Du) :-
!, negation(V, D, T, Du).
and_list([V|Vs], D, ( T , Ts ), Du) :-
negation(V, D, T, Dut),
and_list(Vs, Dut, Ts, Du).
negation(not(V), D, \+T, Du) :-
!, sym_bind(V, D, T, Du).
negation(V, D, T, Du) :-
sym_bind(V, D, T, Du).
sym_bind(V, D, T, D) :-
memberchk(val(V, T), D), !.
sym_bind(V, D, T, [val(V, T)|D]).
note:
false/true instead of 0/1
list to structure translation: could be way shorter, using foldl or DCGs or passing down the operators (that is (;)/2 (,)/2 (+)/1), but this way the Prolog patterns should be clearer...
I could finally finish it while waiting for replies, and improved it using max66's answer.
I made it to accept propositional logic forms too, so models/2 accepts both styles (CNF and Propositional form, based on operators and, not, or, imp, iff that I set).
:- op(400, fy , not).
:- op(500, xfy, and).
:- op(600, xfy, or ).
:- op(700, xfy, imp).
:- op(800, xfy, iff ).
distr(_, [], []).
distr([], _, []).
distr([C|Cs], Ds, Es) :- distr_un(C, Ds, Ss), distr(Cs, Ds, Ts), append(Ss, Ts, Es).
distr_un(_, [], []).
distr_un(C, [D|Ds], [E|Es]) :- append(C, D, E), distr_un(C, Ds, Es).
cnf(F, [[F]]) :- atom(F), !.
cnf(not(F), [[not(F )]]) :- atom(F), !.
cnf(not not F, Rs) :- cnf(F, Rs).
cnf(not (F imp G), Rs) :- cnf(F and not G, Rs).
cnf(not (F iff G), Rs) :- cnf((F and not G) or (not F and G), Rs).
cnf(not(F and G), Rs) :- cnf((not F) or (not G), Rs).
cnf(not(F or G), Rs) :- cnf((not F) and (not G), Rs).
cnf(F and G, Rs) :- cnf(F, Cs), cnf(G, Ds), append(Cs, Ds, Rs).
cnf(F or G, Rs) :- cnf(F, Cs), cnf(G, Ds), distr(Cs, Ds, Rs).
cnf(F imp G, Rs) :- cnf((not F) or G, Rs).
cnf(F iff G, Rs) :- cnf((not F or G) and (not G or F), Rs).
val(X,0) :- atom(X).
val(X,1) :- atom(X).
value(X, [val(X, B)|_], B) :- !.
value(X, [_|Ps], B) :- value(X, Ps, B), !.
value(not X, [val(X, B)|_], V) :- V is 1-B, !.
value(not X, [_|Ps], B) :- value(not X, Ps, B), !.
sp([],[]).
sp([F|Fs], Ss) :- setof(A1, member(not A1, F), R1), setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M1), append(M1, R1, M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(not A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
ext([F|Fs], Vs, B) :- sp([F|Fs], Ss), valuation(Ss, Vs), ext_([F|Fs], Vs, B).
ext_([], _, 1).
ext_([F|Fs], Vs, 1) :- cl(F, Vs, 1), ext_(Fs, Vs, 1).
ext_([F|Fs], Vs, 0) :- cl(F, Vs, 0); ext_(Fs, Vs, 0).
cl([A|As], Vs, 1) :- value(A,Vs,1); cl(As, Vs, 1).
cl([A|As], Vs, 0) :- value(A,Vs,0), cl(As,Vs,0).
cl([], _, 0).
model(F, Vs) :- ext(F, Vs, 1).
models(F, Vs) :- cnf(F, Fs), setof(V, model(Fs, V), Vs).
models(F, Vs) :- setof(V, model(F, V), Vs).
I tested it and it seems to be working as intended.

Brute-force Prolog SAT solver for boolean formulas

I'm trying to write an algorithm that naively looks for models of a boolean formula (NNF, but not CNF).
The code I have can check an existing model, but it'll fail (or not finish) when asked to find models, seemingly because it generates infinitely many solutions for member(X, Y) along the lines of [X|_], [_,X|_], [_,_,X|_]...
What I have so far is this:
:- op(100, fy, ~).
:- op(200, xfx, /\).
:- op(200, xfx, \/).
:- op(300, xfx, =>).
:- op(300, xfx, <=>).
formula(X) :- atom(X).
formula(~X) :- formula(X).
formula(X /\ Y) :- formula(X), formula(Y).
formula(X \/ Y) :- formula(X), formula(Y).
formula(X => Y) :- formula(X), formula(Y).
formula(X <=> Y) :- formula(X), formula(Y).
model(1, _).
model(X, F) :- atom(X), member([X, 1], F).
model(~X, F) :- atom(X), member([X, 0], F). % NNF
model(A /\ B, F) :- model(A, F), model(B, F).
model(A \/ B, F) :- (model(A, F); model(B, F)).
model(A => B, F) :- model(~A \/ B, F).
model(A <=> B, F) :- model((A => B) /\ (B => A), F).
sat(A) :- model(A, F), \+ (member([X, 1], F), member([X, 0], F)).
%%% examples:
% formula(~(~ (a /\ b) \/ (c => d))).
% model(a, [[a,1]]).
Is there a better data structure for F, or some other way the partially-instantiated lists can be cut off?
Edit: Added definitions and examples.
Use clpb!
:- use_module(library(clpb)).
Sample query using sat/1:
?- sat(~(~ (A * B) + (C * D))).
A = B, B = 1, sat(1#C*D).
Some variables (A and B) already have been bound to exactly one Boolean value (in above query), but search is not yet complete (which is indicated by residual goals).
To trigger the smart brute-force enumeration of all solutions use labeling/1 like so:
?- sat(~(~ (A * B) + (C * D))), labeling([A,B,C,D]).
A = B, B = 1, C = D, D = 0
; A = B, B = D, D = 1, C = 0
; A = B, B = C, C = 1, D = 0.
I solved it by writing a generate_model predicate that created a pre-defined list with exactly one element for each variable:
generate_model([], []).
generate_model([X|T], [[X,_]|T2]) :- generate_model(T, T2).
sat(A) :-
var_list(A, Vars),
generate_model(Vars, F),
model(A, F).
Do I understand you, that you are happy with a single model. You
don't need labeling or sat_count. Here is an alternative model finder, that is similar to yours, but will only return consistent models.
Since it finds counter models, you need to supply the negation of the formula to find a model. The predicate maze/3 was developed as a negative implementation of the positive predicate proof/2:
% Find a counter model.
% maze(+Norm,+List,-List)
maze(or(A,_),L,_) :- member(A,L), !, fail.
maze(or(A,B),L,R) :- !, inv(A,C), maze(B,[C|L],R).
maze(and(A,_),L,R) :- maze(A,L,R), !.
maze(and(_,B),L,R) :- !, maze(B,L,R).
maze(A,L,_) :- member(A,L), !, fail.
maze(A,L,M) :- oneof(L,B,R), connective(B), !,
inv(A,C), inv(B,D), maze(D,[C|R],M).
maze(A,L,[B|L]) :- inv(A,B).
It can find counter models to all of the following fallacies:
Affirming a Disjunct: (p v q) & p => ~q.
Affirming the Consequent: (p => q) & q => p.
Commutation of Conditionals: (p => q) => (q => p).
Denying a Conjunct: ~(p & q) & ~p => q.
Denying the Antecedent: (p => q) & ~p => ~q.
Improper Transposition: (p => q) => (~p => ~q).
Here is an example run:
Jekejeke Prolog 2, Runtime Library 1.2.5
(c) 1985-2017, XLOG Technologies GmbH, Switzerland
?- negcase(_,N,F), norm(F,G), maze(G,[],L),
write(N), write(': '), sort(L,R), write(R), nl, fail; true.
Affirming a Disjunct: [pos(p),pos(q)]
Affirming the Consequent: [neg(p),pos(q)]
Commutation of Conditionals: [neg(p),pos(q)]
Denying a Conjunct: [neg(p),neg(q)]
Denying the Antecedent: [neg(p),pos(q)]
Improper Transposition: [neg(p),pos(q)]
Interestingly the thing is much faster than CLP(B). Here are some timings running the same problem in CLP(B) and with maze:
?- time((between(1,1000,_), negcaseclp(_,N,F,L),
sat(~F), once(labeling(L)), fail; true)).
% Up 296 ms, GC 3 ms, Thread Cpu 250 ms (Current 01/27/18 00:34:20)
Yes
?- time((between(1,1000,_), negcase(_,_,F),
norm(F,G), maze(G,[],_), fail; true)).
% Up 82 ms, GC 0 ms, Thread Cpu 78 ms (Current 01/27/18 00:30:21)
Yes

how to stochastic search n-queen in prolog?

i'm implement stochastic search in prolog.
code is
queens_rand([],Qs,Qs) :- !.
queens_rand(UnplacedQs,SafeQs,Qs) :-
random_sort(UnplacedQs, UnplacedQs1),
select(UnplacedQs,UnplacedQs1,Q),
not_attack(SafeQs,Q,1),
queens_rand(UnplacedQs1,[Q|SafeQs],Qs),
!.
queen_solve_rand(N) :-
alloc(1,N,Ns),
queens_rand(Ns,[], Q),
write(Q), nl.
random_sort([],_) :- !.
random_sort(_,[]) :- !.
random_sort(Xs, Ys) :-
length(Ys, L),
rnd_select(Xs,L, Ys),
write('Ys : '),write(Ys),nl.
remove_at(X,[X|Xs],1,Xs).
remove_at(X,[Y|Xs],K,[Y|Ys]) :- K > 1,
K1 is K - 1, remove_at(X,Xs,K1,Ys).
rnd_select(_,0,[]).
rnd_select(Xs,N,[X|Zs]) :- N > 0,
length(Xs,L),
I is random(L) + 1,
remove_at(X,Xs,I,Ys),
N1 is N - 1,
rnd_select(Ys,N1,Zs).
not_attack([],_,_) :- !.
not_attack([Y|Ys],X,N) :-
X =\= Y+N, X =\= Y-N,
N1 is N+1,
not_attack(Ys,X,N1).
select([X|Xs],Xs,X).
select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
but it returns false. i can't understand prolog well, but i have to implement it. and i cant find where is wrong.
Yyou should remove this rule : random_sort(_,[]) :- !.. It means that whatever is the first arg, the result is [].

setof in prolog

what is the source code of setof in prolog?
?- listing(setof).
:- meta_predicate setof(?,0,-).
setof(A, B, F) :-
free_variable_set(A, B, D, C),
( C==v
-> findall(A, D, E),
E\==[],
sort(E, F)
; findall(C-A, D, E),
( ground(E)
-> sort(E, G),
pick(G, C, F)
; bind_bagof_keys(E, _),
sort(E, G),
pick(G, C, H),
sort(H, F)
)
).
true.
In case you are looking for the Sicstus built-in predicate implementation, it can be found here: http://www.sics.se/sicstus/docs/4.2.1/html/sicstus/mpg_002dref_002dsetof.html as:
setof(+Template, +Generator, -Set)
Unlike findall/3 and bagof/3, setof does not return duplicates and does give sorted order.
I.

Resources