请参阅最后的修改
我正在努力解决这个问题，我想知道是否存在可以帮助我的东西:)。因此，让我们定义要解决的问题：
示例： 我们有12项称为1 2 3 4 5 6 7 8 9 A B C
结果可能是
1 - 1234 5678 9ABC
2 - 1259 346B 789A
以及其他人验证（X> 1，X等于）：
＆＃34; 1＆＃34;与{2,3,4,5,6,7,8,9，A，B，C}发生X次相同的集合
＆＃34; 2＆＃34;与{1,3,4,5,6,7,8,9，A，B，C}在同一组中发生X（与以前相同的X）次
等
更新
这类似于社交高尔夫球手的问题。 不同之处在于，我并不要求每个玩家在每个玩家中再次玩相同的时间，但是他会玩同样数量的玩家。 我发现了一个基于＆＃34;复杂＆＃34;的解决方案。算法但也有更优雅的方法可以做到。
12的结果是
[1] (1 12 11 10) (2 9 8 7) (3 6 5 4)
[2] (1 9 6 5) (3 12 8 7) (2 11 4 10)
[3] (10 9 3 8) (7 11 6 5) (1 4 12 2)
[4] (8 11 6 5) (7 10 4 1) (12 9 3 2)
[5] (5 12 2 10 (1 8 4 9) (11 3 7 6)
[6] (6 12 2 10) (1 3 9 11) (4 8 7 5)
每位球员的对手名单是：
[1] plays against 18 players : [10, 10, 11, 11, 12, 12, 2, 3, 4, 4, 4, 5, 6, 7, 8, 9, 9, 9]
[2] plays against 18 players : [1, 10, 10, 10, 11, 12, 12, 12, 12, 3, 4, 4, 5, 6, 7, 8, 9, 9]
[3] plays against 18 players : [1, 10, 11, 11, 12, 12, 2, 4, 5, 6, 6, 7, 7, 8, 8, 9, 9, 9]
[4] plays against 18 players : [1, 1, 1, 10, 10, 11, 12, 2, 2, 3, 5, 5, 6, 7, 7, 8, 8, 9]
[5] plays against 18 players : [1, 10, 11, 11, 12, 2, 3, 4, 4, 6, 6, 6, 6, 7, 7, 8, 8, 9]
[6] plays against 18 players : [1, 10, 11, 11, 11, 12, 2, 3, 3, 4, 5, 5, 5, 5, 7, 7, 8, 9]
[7] plays against 18 players : [1, 10, 11, 11, 12, 2, 3, 3, 4, 4, 5, 5, 6, 6, 8, 8, 8, 9]
[8] plays against 18 players : [1, 10, 11, 12, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 7, 9, 9, 9]
[9] plays against 18 players : [1, 1, 1, 10, 11, 12, 2, 2, 3, 3, 3, 4, 5, 6, 7, 8, 8, 8]
[10] plays against 18 players : [1, 1, 11, 11, 12, 12, 12, 2, 2, 2, 3, 4, 4, 5, 6, 7, 8, 9]
[11] plays against 18 players : [1, 1, 10, 10, 12, 2, 3, 3, 4, 5, 5, 6, 6, 6, 7, 7, 8, 9]
[12] plays against 18 players : [1, 1, 10, 10, 10, 11, 2, 2, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9]
该算法在28名玩家之后有点长（以分钟计）...
答案 0 :(得分：0)
以下是SWI Prolog中可能的答案，具体取决于我是否正确理解了问题：
给定一组N个元素 K ，找到一组 K 的子集（集合 ＆＃34;配对＆＃34;）使得每个子集的基数为 PairingSize 和 K 的每个元素都出现在子集的 PairingDegree 中。
以下似乎可行。花了很长时间才想到一个很好的技巧来做到这一点。
:- use_module(library(tabling)).
% ===
% Settings
% ===
% We have 12 items, which we represent as a list of items.
% We can then "pull in" the items in a predicate by unifiying with L, then
% iterate/recurse over the length of L. If a constraint / checking predicate
% fails at position "n", we can get out from the recursion elegantly without
% a cut, as there is no backtracking.
% The alternative is to declare the individual items as facts: item(i1),
% item(i2) etc. In that case, iterating/recursing over the items involves
% fighting Prolog's backtracking using cuts. Feels bad, man.
items([i1,i2,i3,i4,i5,i6,i7,i8]).
% Set the cardinality of the items here. It is a tabled predicate so that it
% is not computed again and again.
:- table items_card/1.
items_card(Cardinality) :- items(Items), length(Items,Cardinality).
% Set the "pairing size" here to avoid having to pass it around as a variable.
pairing_size(4).
% Set the "pairing degree" here to avoid having to pass it around as a variable
pairing_degree(4).
% ===
% Generate selections of "Len" elements selected from "ListIn", yielding "ListOut".
% select_sublist(+ListIn, +Len, -ListOut)
% ===
% Backtracking generates the selections. There is a canonical order to the generated
% alternatives.
%
% ?- select_sublist([a,b,c,d],2,X).
% X = [a, b] ;
% X = [a, c] ;
% X = [a, d] ;
% X = [b, c] ;
% X = [b, d] ;
% X = [c, d] ;
% false.
select_sublist([H|R], Len, [H|ListMid]) :-
Len > 0,
SubLen is Len-1,
select_sublist(R, SubLen, ListMid).
select_sublist([_|R], Len, ListMid) :-
Len > 0,
select_sublist(R, Len, ListMid).
select_sublist(_, 0, []).
% ===
% Generate all possible unique pairings (structurally, a pairing is a list)
% ===
% This is done using bagof/3 fully generating all the solutions of select_sublist/3.
% Each pairing is ordered internally in a canonical way (i.e. [i1,i3,i5,i6] instead of
% [i5,i3,i1,i6]) and the list of pairings canonically ordered, too, as given by select_sublist/3.
% There will be O(length(items)^pairing_size) pairings.
build_all_pairings(Pairings) :-
items(Items),
pairing_size(Psize),
bagof(Px, select_sublist(Items, Psize, Px), Pairings).
% ===
% Generate a mapping index -> Pairing
% ===
% The complete list of unique pairings is the structure that we iterate over in several
% "contexts on the stack" (i.e. there will be several 'fingers' pointing into that list). We
% have to do that explicitly and cannot hand off the responsiblity of doing this to the
% Prolog stack and backtracking mechanism. We need to compute the "next pairing"
% often.
% In an pointer&struct-using language, one would have a linked list of "pairings",
% and a given "pointer to pairing" would thus immediately yield the "next pairing".
% Here we seem to need to explicitly search through the list (or maybe use the dynamic
% database or tabling of the search predicate).
% We do the following: a position in the list of unique pairings is given by an index
% 0..L-1, and we create a dict mapping indexes to pairings.
structify(Pairings, DictPs) :-
x_structify_recur(Pairings, 0, _{}, DictPs).
x_structify_recur([P|Ps], Index, DictIn, DictOut) :-
DictMid = DictIn.put(Index, P),
IndexNext is Index+1,
x_structify_recur(Ps, IndexNext, DictMid, DictOut).
x_structify_recur([], _, DictWind, DictWind).
% ===
% Pairing Evaluation
% ===
% Evaluate a list of pairings. The "Result" may become:
%
% "match" - Every item appears exactly "pairing degree" times in the list of pairings; this means we have a solution!
% "over" - At least one item appears more often than "pairing degree" times; this is not a solution!
% "overex" - Over signalled via an exception (early return). In this case, the Dict is unset on return.
% "hopeless" - There are less than "pairing size" items which appear less than "pairing degree" times;
% adding another pairing will lead to "over" (this is a slight optimization, which could be optimized further)
% "under" - Any other case. Pairing may be added to possibly reach "match".
%
% I am not completely sure how to handle "early return if 'over' case" without making the code messy,
% let's try with an Exception.
%
% Example with 12 items, pairing size 3, degree 3
%
% ?- appraise_pairings([[i1,i2,i3],[i2,i4,i5]],R,Pcd)
% R = under,
% Pcd = _2266{i1:1, i10:0, i11:0, i12:0, i2:2, i3:1, i4:1, i5:1, i6:0, i7:0, i8:0, i9:0}.
%
% ?- appraise_pairings([[i1,i2,i3],[i2,i4,i5],[i2,i6,i7],[i2,i8,i10]],R,Pcd).
% R = overex.
%
% ?- appraise_pairings([[i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12],
% [i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12],
% [i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12]],R,Pcd).
% R = match,
% Pcd = _294{i1:3, i10:3, i11:3, i12:3, i2:3, i3:3, i4:3, i5:3, i6:3, i7:3, i8:3, i9:3}.
%
% ?- appraise_pairings([[i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12],
% [i1,i2,i3,i4,i5,i6,i7,i8,i9,i10],
% [i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12]],R,Pcd).
%
% R = hopeless,
% Pcd = _34{i1:3, i10:3, i11:2, i12:2, i2:3, i3:3, i4:3, i5:3, i6:3, i7:3, i8:3, i9:3}.
appraise_pairings(Pairings,Result,PcdOut) :-
catch(appraise_pairings_catchable(Pairings,Result,PcdOut),over,Result=overex).
appraise_pairings_catchable(Pairings,Result,PcdOut) :-
initial_pairing_count_dict(PcdInit),
% call this may throw to return early
update_pcd_with_pairings_recur(Pairings,PcdInit,PcdOut),
% the above did not throw - appraise the full result
items(Items),
appraise_filled_pcd_recur(Items,PcdOut,0,0,Result).
% increase values kept in dict by recursing over pairings
update_pcd_with_pairings_recur([Pairing|Rest],PcdIn,PcdOut) :-
update_pcd_with_items_recur(Pairing,PcdIn,PcdMid),
update_pcd_with_pairings_recur(Rest,PcdMid,PcdOut).
update_pcd_with_pairings_recur([],PcdWind,PcdWind).
% increase values kept in dict by 1 by recursing over items
update_pcd_with_items_recur([Item|Rest],PcdIn,PcdOut) :-
pairing_degree(Pdeg),
U is PcdIn.Item + 1,
% We can already "return early" here with "over" if U is above "pairing degree".
( U > Pdeg ->
throw(over) ;
( PcdMid = PcdIn.put(Item,U), update_pcd_with_items_recur(Rest,PcdMid,PcdOut) ) ).
update_pcd_with_items_recur([],PcdWind,PcdWind).
% Appraise the "item->item occurence count" function in the "Pcd" dictionary,
% by recursing over all items. Initially, the "counts" are all 0 and the "Result" is unset.
% Once all the items have been checked, the Result is set based on the "counts".
% Note that we can break off early if we find an item that is "over".
appraise_filled_pcd_recur([Item|_Rest],Pcd,_MatchCount,_UnderCount,over) :-
pairing_degree(Pdeg),
Pcd.Item > Pdeg,!. % early return here with "over"
appraise_filled_pcd_recur([Item|Rest],Pcd,MatchCount,UnderCount,Result) :-
pairing_degree(Pdeg),
Pcd.Item == Pdeg,!,
U is MatchCount + 1,
appraise_filled_pcd_recur(Rest,Pcd,U,UnderCount,Result).
appraise_filled_pcd_recur([Item|Rest],Pcd,MatchCount,UnderCount,Result) :-
pairing_degree(Pdeg),
Pcd.Item < Pdeg,!,
U is UnderCount + 1,
appraise_filled_pcd_recur(Rest,Pcd,MatchCount,U,Result).
% .... Result is "match" if every item appears with the sought-for pairing degree:
appraise_filled_pcd_recur([],_,MatchCount,_UnderCount,match) :- items_card(C), MatchCount == C, !.
% .... Result is "hopeless" if there are less than pairing size items left with undercount:
appraise_filled_pcd_recur([],_,_MatchCount,UnderCount,hopeless) :- pairing_size(S), UnderCount < S, !.
% .... Result is "under" in any other case (for now):
appraise_filled_pcd_recur([],_,_,_,under).
% ===
% This creates a SWI Prolog dictionary to count number of occurrences of an item.
% The "initial dict" is "0 everywhere".
% ===
% ?- initial_pairing_count_dict(X).
% X = _3296{i1:0, i10:0, i11:0, i12:0, i2:0, i3:0, i4:0, i5:0, i6:0, i7:0, i8:0, i9:0}.
:- table initial_pairing_count_dict/1.
initial_pairing_count_dict(Pcd) :-
items(Items),
x_putzero_recur(_{},Items,Pcd).
x_putzero_recur(PcdIn,[Item|Rest],PcdOut) :-
PcdMid = PcdIn.put(Item,0),
x_putzero_recur(PcdMid,Rest,PcdOut).
x_putzero_recur(PcdWind,[],PcdWind).
% ===
% Here is where it's done!
% ===
% Choose a set of pairings (putting them into a canonical list of pairings, a
% list of lists) such that the pairing degree of every item (i.e. the number of times
% an item appears in a pairing) is equal to the "pairing degree".
% Several "Cursors" point into the canonically ordered list of possible pairings.
% The cursors form a stack. We manage the cursors ourselves and do not let Prolog do it via
% its execution stack (Could we do it? I didn't find a nice way to do it)
find_matches(MatchesOut) :-
build_all_pairings(Pairings),
structify(Pairings, DictPs),
CursorStack = [0],
PairingStack = [DictPs.0],
length(Pairings, NumPs),
% format('There are ~d pairings~n', [NumPs]),
find_matches_recur(NumPs, DictPs, CursorStack, PairingStack, [], MatchesOut).
% find_matches_recur MUST be tailrecursive because this is an iteration over possible cursor/stack
% states (a large number) and we really don't want to make this fully recursive.
% To get rid of useless choicepoints, we can just add a "!" in the middle... this keeps us from
% the stack sky-high
find_matches_recur(NumPs, DictPs, CursorStackIn, PairingStackIn, MatchesIn, MatchesOut) :-
log_stack(CursorStackIn),
appraise_pairings(PairingStackIn, Result, _),
format('Obtained ~w for ~w~n', [Result, PairingStackIn]),
on_result(Result, NumPs, DictPs, CursorStackIn, CursorStackMid, PairingStackIn, PairingStackMid, MatchesIn, MatchesMid),
% cut the stack off
!,
% if the cursor stack has reduced to the empty stack, we are done and this is the last instruction, otherwise tail-recurse
( CursorStackMid == []
->
MatchesOut = MatchesIn
; find_matches_recur(NumPs, DictPs, CursorStackMid, PairingStackMid, MatchesMid, MatchesOut) ).
% log
log_stack(CursorStack) :-
reverse(CursorStack,P),
format('Current stack ~w~n', [P]).
% ===
% Build the stack of pairings from the stack of cursors
% ===
%build_pairing_stack(DictPs, CursorStackIn, PairingStackIn, PairingStackOut) :-
% [MyCursor|RestOfCursors] = CursorStackIn,
% MyPairing = DictPs.MyCursor,
% build_pairing_stack(DictPs, RestOfCursors, [MyPairing|PairingStackIn], PairingStackOut).
%
%build_pairing_stack(_, [], PairingStackWind, PairingStackWind).
% ===
% What to do depending on intermediate Result
% ===
% over or hopeless
on_result(R, NumPs, DictPs, CursorStackIn, CursorStackOut, PairingsStackIn, PairingsStackOut, MatchesWind, MatchesWind) :-
( R == over ; R == overex ; R == hopeless ), !, advance_cursor(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingsStackIn, PairingsStackOut).
% under
on_result(under, NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut, MatchesWind, MatchesWind) :-
( deepen_stack(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut)
->
true
; advance_cursor(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut) ).
% match
on_result(match, NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut, MatchesIn, MatchesOut) :-
MatchesOut = [PairingStackIn|MatchesIn],
log_match(MatchesOut),
advance_cursor(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut).
% log
log_match(Matches) :-
length(Matches,Solutions),
format('*** ~d solutions so far ***~n', [Solutions]).
% ===
% Advance the lowermost cursor on the stack
% ===
% This may cause the stack to be "popped", possibly down to the empty stack if we are done
advance_cursor(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut) :-
CursorStackIn = [MyCursor|RestOfCursors],
PairingStackIn = [_|RestOfPairings],
NextMyCursor is MyCursor+1,
( NextMyCursor >= NumPs
->
advance_cursor(NumPs, DictPs, RestOfCursors, CursorStackOut, RestOfPairings, PairingStackOut)
;
( CursorStackOut = [NextMyCursor|RestOfCursors] , PairingStackOut = [DictPs.NextMyCursor|RestOfPairings] )).
advance_cursor(_, _, [], [], [], []).
% ===
% Deepen the stack by one
% ===
% This means creating a new "stack frame" that is one index further than the current "stack frame"
% This may fail if this results in a bad index
deepen_stack(NumPs, DictPs, CursorStackIn, CursorStackOut, PairingStackIn, PairingStackOut) :-
CursorStackIn = [MyCursor|_],
NextMyCursor is MyCursor+1,
( NextMyCursor >= NumPs
->
fail
; ( CursorStackOut = [NextMyCursor|CursorStackIn], PairingStackOut = [DictPs.NextMyCursor|PairingStackIn] ) ).
可悲的是，它并没有在在线Swish界面中运行：
沙盒限制！ 无法导出可以调用哪个谓词 来自＆＃39; $ dicts＆＃39;：＆＃39;。＆＃39;（C，D，E）
然后它只是：
?- find_matches(MatchesOut).