sorting - 如何修复这个排列排序？

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.

如何解决以下问题？

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

?- 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 著名论文 Predicate Logic as Programming Language 第 11 节中给出的 Horn 子句程序。 :

Answer 1

要解决不终止问题，您可以按照@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).

程序仍会返回重复项，因为它一次只能看到一项。

要解决重复问题，您可以生成所有排列并丢弃重复的排列(效率不高)，或者只生成不同的排列。以下修改通过采用递归过程 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.

---

根据 OP 评论要求不使用差异列表的版本，这里有一个使用 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).