相同位置元素不匹配的两列表组合求解：石头剪刀布对局排序

给定多局石头剪刀布的无序出拳记录，且所有对局无平局，需要找出所有可行的对局顺序，该谜题来自Hubert Phillips。

现有两个格式如[Rock, Rock, Scissors...]的出拳列表，分别对应两个玩家的所有出拳记录。

参考Python实现 #

以下Python代码通过循环移位第一个玩家的出拳序列，找到第一个满足无平局的配对顺序：

one, two = 'rrrssssssp', 'rrsssspppp'

while True in [t[0] == t[1] for t in zip(one, two)]:
    one = one[1:] + one[0]

print(one, two)

对该方法做全量遍历后可知，该场景下仅存在一个可行解。

现有Prolog实现存在的问题 #

尝试编写的Prolog代码如下，运行仅返回True，无法得到预期的可行序列：

% results.pl
one([r, r, r, s, s, s, s, s, s, p]).
two([r, r, s, s, s, s, p, p, p, p]).

ordered_results(L) :-
        findall((I,J), (member(I, one), member(J, one), I \== J), []).

?- [results].
?- ordered_results(one, two).

问题原因 #

1. 谓词定义和调用参数不匹配：ordered_results定义仅接收1个参数，调用时传入了2个参数。
2. 逻辑完全不符合需求：代码中member(I, one)是针对one原子取成员，而非one谓词对应的出拳列表，且查询逻辑和「循环移位、无平局配对」的核心需求无关，因此只会永远返回真。

% results.pl
% 玩家1的出拳列表
one([r, r, r, s, s, s, s, s, s, p]).
% 玩家2的出拳列表
two([r, r, s, s, s, s, p, p, p, p]).

% 单次循环移位：将列表第一个元素移到末尾
rotate([H|T], Rotated) :- append(T, [H], Rotated).

% 生成列表的所有循环移位结果
all_rotations(List, Rotations) :-
    length(List, Len),
    length(StepList, Len),
    foldl({List}/[_, [Prev|Rest], [Current, Prev|Rest]]>>(rotate(Prev, Current)), StepList, [List], [_|RevRotations]),
    reverse(RevRotations, Rotations).

% 校验两个列表对应位置配对无平局
no_ties([], []).
no_ties([X|Xs], [Y|Ys]) :-
    X \= Y,
    no_ties(Xs, Ys).

% 查询可行的对局顺序
valid_order(ShiftedOne, Two) :-
    one(One),
    two(Two),
    all_rotations(One, AllShifts),
    member(ShiftedOne, AllShifts),
    no_ties(ShiftedOne, Two).

运行效果 #

在Prolog终端执行查询即可得到唯一解：

?- [results].
true.

?- valid_order(ShiftedOne, Two).
ShiftedOne = [s, s, s, s, s, p, r, r, r, s],
Two = [r, r, s, s, s, s, p, p, p, p] ;
false.

内容的提问来源于stack exchange，提问作者Josh Friedlander