求助，用正向推理的方法填3x3的表格，回溯不能

最近刚接触正向推理方法（ http://hyry.dip.jp:8000/cdtzx/program/prologadv24.htm ），接触了值域的概念，依然想从最简单的目标入手，比如用[1,2,3]的值域填一个3x3的表格，要求每行每列的数字各不相同，如
1，2，3
2，3，1
3，1，2
等，共12个解。这个目标用逆向推理法（生成所以可能的解，逐一检验）也容易实现。
但是我想试着用正向推理法，先找出第一行和第一列的值域，然后给第一个变量赋值，然后修改第一行和第一列的值域；找出第一行和第二列的值域，给第二个变量赋值，然后修给第一行和第二列的值域，以此类推，直到第九个变量。这样可以找到一个解，但之后回溯到第二行第二列的变量时出错，求前辈们指导。

assignS(s(X,Y,VS)):-(rl(X,Rl),rc(Y,Rc),intersection(Rl,Rc,RS)->RS\=[]),member(VS,RS),
%先求出每个格子s(X,Y,VS))关联的值域，然后求行值域和列值域交集，然后用member谓词从交集里面对VS赋值

subtract(Rl,[VS],Rl1),subtract(Rc,[VS],Rc1),
%生成新的行值域Rl1，和新的列值域Rc1,
asserta(rl(X,Rl1)),asserta(rc(Y,Rc1)).
%把新生成的值域写进内存，排在前面


sset([s(1,1,S11),s(1,2,S12),s(1,3,S13),s(2,1,S21),s(2,2,S22),s(2,3,S23),s(3,1,S31),s(3,2,S32),s(3,3,S33)]).
%初始化表格
%下面是主程序
assignment3x3cell(Sset):-
maplist(asserta,[rl(1,[1,2,3]),rl(2,[1,2,3]),rl(3,[1,2,3]),rc(1,[1,2,3]),rc(2,[1,2,3]),rc(3,[1,2,3])]),
/*初始化值域，rl(1,[1,2,3])表示第1行的值域为[1,2,3]，rc(1,[1,2,3])表示第1列的值域为[1,2,3]，*/
sset(Sset),maplist(assignS,Sset),
%用正向推理法把表填满
assert(count(0)),count(N),retract(count(0)),NN is N+1,write(NN),asserta(count(NN)),
(NN>1->retract(count(N));true),
%Liao sir教的计数方法
Sset =[s(1,1,S11),s(1,2,S12),s(1,3,S13),s(2,1,S21),s(2,2,S22),s(2,3,S23),s(3,1,S31),s(3,2,S32),s(3,3,S33)],
maplist(writeln,[(S11,S12,S13),(S21,S22,S23),(S31,S32,S33)]).

做出来了，还是正向推理法，程序尚未减肥，稍晚一些时候添加注释
assignnewS([],_,_).
assignnewS([H|T],SetR,Route):-H=s(X,Y,S),
subtract(SetR,[rr(X,Rrs),rc(Y,Rcs)],Rest1),subtract(Route,[rr(X,Rr),rc(Y,Rc)],Rest),
subtract(Rrs,Rr,Rr1), subtract(Rcs,Rc,Rc1),
intersection(Rr1,Rc1,Rs),member(S,Rs),
append([rr(X,[S|Rr]),rc(Y,[S|Rc])],Rest,Newroute),assignnewS(T,SetR,Newroute).

assignment3x3cell_new(Sset):-
Initialization_route=[rr(1,[]),rr(2,[]),rr(3,[]),rc(1,[]),rc(2,[]),rc(3,[])],
Sset =[s(1,1,S11),s(1,2,S12),s(1,3,S13),s(2,1,S21),s(2,2,S22),s(2,3,S23),s(3,1,S31),s(3,2,S32),s(3,3,S33)],
Setrange=[rr(1,[1,2,3]),rr(2,[1,2,3]),rr(3,[1,2,3]),rc(1,[1,2,3]),rc(2,[1,2,3]),rc(3,[1,2,3])],
assignnewS(Sset,Setrange,Initialization_route),
assertz(count(0)),count(N),retract(count(0)),NN is N+1,write(NN),asserta(count(NN)), write(.), nl,
aplist(writeln,[(S11,S12,S13),(S21,S22,S23),(S31,S32,S33)]),
fail.
assignment3x3cell_new(Sset):-retract(count(N)),fail.

上面的程序是成功版1.0，尚未减肥，欢迎大家点评。
这是运行结果，12个解
?- assignment3x3cell_new(Sset).
1.
1,2,3
2,3,1
3,1,2
2.
1,2,3
3,1,2
2,3,1
3.
1,3,2
2,1,3
3,2,1
4.
1,3,2
3,2,1
2,1,3
5.
2,1,3
1,3,2
3,2,1
6.
2,1,3
3,2,1
1,3,2
7.
2,3,1
1,2,3
3,1,2
8.
2,3,1
3,1,2
1,2,3
9.
3,1,2
1,2,3
2,3,1
10.
3,1,2
2,3,1
1,2,3
11.
3,2,1
1,3,2
2,1,3
12.
3,2,1
2,1,3
1,3,2
false.

fuyunv 写道:做出来了，还是正向推理法，程序尚未减肥，稍晚一些时候添加注释
assignnewS([],_,_).
assignnewS([H|T],SetR,Route):-H=s(X,Y,S),
subtract(SetR,[rr(X,Rrs),rc(Y,Rcs)],Rest1),subtract(Route,[rr(X,Rr),rc(Y,Rc)],Rest),
subtract(Rrs,Rr,Rr1), subtract(Rcs,Rc,Rc1),
intersection(Rr1,Rc1,Rs),member(S,Rs),
append([rr(X,[S|Rr]),rc(Y,[S|Rc])],Rest,Newroute),assignnewS(T,SetR,Newroute).

assignment3x3cell_new(Sset):-
Initialization_route=[rr(1,[]),rr(2,[]),rr(3,[]),rc(1,[]),rc(2,[]),rc(3,[])],
Sset =[s(1,1,S11),s(1,2,S12),s(1,3,S13),s(2,1,S21),s(2,2,S22),s(2,3,S23),s(3,1,S31),s(3,2,S32),s(3,3,S33)],
Setrange=[rr(1,[1,2,3]),rr(2,[1,2,3]),rr(3,[1,2,3]),rc(1,[1,2,3]),rc(2,[1,2,3]),rc(3,[1,2,3])],
assignnewS(Sset,Setrange,Initialization_route),
assertz(count(0)),count(N),retract(count(0)),NN is N+1,write(NN),asserta(count(NN)), write(.), nl,
aplist(writeln,[(S11,S12,S13),(S21,S22,S23),(S31,S32,S33)]),
fail.
assignment3x3cell_new(Sset):-retract(count(N)),fail.

个人观感，结果是次要的，能说明为何是正向推理法最好。

正向推理的意思是从小的事实产生大的事实，以此题目来说，要产生一个合格的方阵，应该是先有一个最小的方阵[[A,B],[B,A]]已经合格，然後可以把这个方阵当材料，搭着一些规则而产生合格的3x3方阵。

个人观感，结果是次要的，能说明为何是正向推理法最好。

正向推理的意思是从小的事实产生大的事实，以此题目来说，要产生一个合格的方阵，应该是先有一个最小的方阵[[A,B],[B,A]]已经合格，然後可以把这个方阵当材料，搭着一些规则而产生合格的3x3方阵。[/quote]

多谢yauhsien关注，此帖还在编辑中，我稍后会补充一些说明

很仔细阅读并猜测，大概看懂assignnewS/3这些代码的意思。就是弄一个空列表，参考一个范本列表，希望能产生把这个空列表填满的结果。我觉得这个思考方式比较是由一般程序撰写的经验而来，你要先弄个阵列空间，然後把值填到这个阵列。

要说正向推理的规则有哪些，虽不能说是，但我看了代码说不出个所以然。

我的想法是比较简单的：我说一个列表跟另一个列表有所不同，规则只有这二行， (前提是每个项目都不同，并且列表只有三个项目)

代码:


different([A,B,C], [C,A,B]).
different([A,B,C], [B,C,A]).


那麽取3x3方阵就是这样子做：第二列与第一列不同，第三列与第一、二列不同，

代码:


take3x3(L, [L,L1,L2]) :-
    different(L, L1), different(L1, L2), L2 \= L1.


至於求解的命令则由以下代码帮忙，

代码:


solve(List) :- perm(List, PList), take3x3(PList, Square), show(Square).
perm([A], [A]).
perm(List, [H|T]) :- member(H, List),
    setof(X, (member(X,List), X \= H), T1), perm(T1, T).
show([L1,L2,L3]) :- write(L1), nl, write(L2), nl, write(L3), nl.

?- solve([1,2,3]).


我说排列是正向推理法，因为我有个规则说：把列表的每一个项目拿来当头，其他的再排列来当尾，一定会产生新的排列。而我丢进一个[1,2,3]到perm/2，它就制造1,2,3的六种排列。

我说take3x3/2是正向推理，因为我有个列表[1,2,3]，并且有个规则说different([1,2,3], [3,1,2])表示[3,1,2]不与[1,2,3]相同，并且另外有个规则同理，使我能找到[2,3,1]与[1,2,3]不同。接着，在take3x3/2中，我说对一个L，只要拿一个L1与L不同，再拿一个L2与L1不同、且与L不同，这样就是都不相同的三列。所以只要一take3x3([1,2,3]，Sq)，就拿到一个Sq方阵，至少知道Sq的三列都不同。我从小的事实加上已经知道确实如此的规则，制造出正确、合适的结果，这个方法是正向推理。

但是，在里头，缺乏足够的知识能让我解释为什麽方阵的三行也都符合[A,B,C]，而不会出现[A,B,A]的情况。可能是碰巧没有制造出那种情况吧！

我帮你把原贴找回来了，
要谢就谢google吧！我搜你的标题，
在它的快照里发现被你误删的原贴。

没先跟你说一声，擅自编辑你的原贴把误删的东西加回去，
想说这样让大家可以更加了解这个问题想讨论什么，
勿见怪哈。