如何修复这种排列排序？

Question

下面的 Prolog 程序定义了一个谓词 sorted/2 用于按第一个参数传递的列表的升序排序（排列排序），结果是第二个参数传递的列表：

sorted(X, Y) :-
  permuted(X, Y),
  ordered(Y).

permuted([], []).
permuted(U, [V|W]) :-
  permuted(X, W),
  deleted(V, U, X).

deleted(X, [X|Y], Y).
deleted(U, [V|W], [V|X]) :-
  deleted(U, W, X).

ordered([]).
ordered([_]).
ordered([X, Y|Z]) :-
  ordered([Y|Z]), X =< Y.

如何解决以下问题？

程序重复查询的解决方案，其中在第二个参数中传递了包含重复元素的列表：

?- sorted(X, [1, 1, 2]).
   X = [1, 1, 2]
;  X = [1, 1, 2]
;  X = [1, 2, 1]
;  X = [1, 2, 1]
;  X = [2, 1, 1]
;  X = [2, 1, 1]
;  false.

对于在第二个参数中传递自由变量的查询，程序耗尽了资源：

?- sorted([2, 1, 1], Y).
   Y = [1, 1, 2]
;  Y = [1, 1, 2]
;
Time limit exceeded

Prolog 程序基于 Robert Kowalski 著名论文第 11 节给出的 Horn 子句程序 Predicate Logic as Programming Language:

Answer 1

你的第二个问题可以通过将第一行替换为

来解决

sorted(X, Y) :-
  permuted(X, Y),
  ordered(Y),
  !.

或

sorted(X, Y) :-
  permuted(X, Y),
  ordered(Y),
  length(X, Z),
  length(Y, Z).

第一个不是那么容易解决的，因为这个算法的实现。第一个 [1, 1, 2] 和第二个 [1, 1, 2] 都是有效的排列，因为生成排列的代码会生成所有排列而不是唯一排列。

Answer 2

要解决非终止，您可以按照@false的建议将same_length/2添加到sorted/2：

sorted(X, Y) :-
  same_length(X, Y),
  permuted(X, Y),
  ordered(Y).

same_length([], []).
same_length([_|Xs], [_|Ys]) :-
  same_length(Xs, Ys).

或者您可以通过添加新参数将其嵌入 permuted/2：

sorted(X, Y) :-
  permuted(X, X, Y),
  ordered(Y).

permuted([], [], []).
permuted(U, [_|L1], [V|W]) :-
  permuted(X, L1, W),
  deleted(V, U, X).

该程序仍会 return 重复，因为它一次只能看到一个项目。

要解决重复，您可以生成所有排列并丢弃重复的排列（效率不高），或者只生成不同的排列。以下修改通过采用递归过程 permuted/2 + deleted/2 的思想来实现后者，对于每个项目将其放在列表的开头并对剩余列表进行递归调用，并更改它到另一个递归过程 permuted_all/2 + deleted_all/2，对于每个组相同的项目，将它们放在列表的开头，并对剩余列表进行递归调用。此程序使用 difference lists 以提高效率：

sorted(X, Y) :-
  same_length(X, Y),
  permuted_all(X, Y),
  ordered(Y).
    
permuted_all([], []).
permuted_all(U, [V|W]) :-
  deleted_all(V, U, X, n-T, [V|W]),
  permuted_all(X, T).
    
% deleted_all(Item, List, Remainder, n-T, Items|T)
deleted_all(_, [], [], y-[X|Xs], [X|Xs]).
deleted_all(X, [V|Y], [V|Y1], y-[X|Xs], Xs1) :-
  dif(X, V),
  deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(X, [X|Y], Y1, _-Xs, Xs1) :-
  deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(U, [V|W], [V|X], n-T, Xs) :-
  dif(U, V),
  deleted_all(U, W, X, n-T, Xs).

样本运行：

?- sorted(X, [1, 1, 2]).
   X = [1, 2, 1]
;  X = [1, 1, 2]
;  X = [2, 1, 1]
;  false.

?- sorted([2, 1, 1], Y).
   Y = [1, 1, 2]
;  false.

根据要求不使用差异列表的版本的 OPs 评论，这里有一个使用 same_length/2 + append/3 并添加评论获得余数的版本：

permuted_all([], []).
permuted_all(U, [V|W]) :-
  deleted_all(V, U, X, n, [V|W]),
  same_length(X, T),    % the remaining list X has the same length as T
  append(_, T, [V|W]),  % T corresponds to the last items of [V|W]
  permuted_all(X, T).   % T is a permutation of X
    
% deleted_all(Item, List, Remainder, n, Items|_)
deleted_all(_, [], [], y, _).  % base case
deleted_all(X, [V|Y], [V|Y1], y, Xs1) :-
  % recursive step when the current item is not the one we are gathering
  dif(X, V),
  deleted_all(X, Y, Y1, y, Xs1).
deleted_all(X, [X|Y], Y1, _, [X|Xs1]) :-
  % recursive step when the current item is the one we are gathering
  deleted_all(X, Y, Y1, y, Xs1).
deleted_all(U, [V|W], [V|X], n, Xs) :-
  % recursive step when we have not selected yet the item we will be gathering
  dif(U, V),
  deleted_all(U, W, X, n, Xs).

如何修复这种排列排序？

How to fix this permutation sort?

sorting

duplicates

prolog

termination

failure-slice