How to fix this permutation sort?

Question

The following Prolog program defines a predicate sorted/2 for sorting by permutation (permutation sort) in ascending order a list passed in first argument, which results in the list passed in second argument:

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.

How to solve the following issues?

1. The program duplicates solutions for queries in which a list with duplicate elements is passed in second argument:

?- 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.

2. The program exhausts resources for queries in which a free variable is passed in second argument:

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

---

The Prolog program is based on the Horn clause program given at section 11 of Robert Kowalski’s famous paper Predicate Logic as Programming Language:

Answer 1

To solve non-termination, you can add same_length/2 to sorted/2 as @false suggested:

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

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

Or you may embed it into permuted/2 by adding a new argument:

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

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

The program will still return duplicates as it only sees one item at a time.

To solve duplication, you can either generate all permutations and discard the repeated ones (which is not efficient), or only generate distinct permutations. The following modification does the latter by taking the idea of the recursive procedure permuted/2 + deleted/2 which for each item puts it at the beginning of the list and does a recursive call on the remaining list, and changes it to another recursive procedure permuted_all/2 + deleted_all/2 which for each group of same items puts them at the beginning of the list and does a recursive call on the remaining list. This program uses difference lists for better efficiency:

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).

Sample runs:

?- 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.

---

As per OPs comment asking for a version which does not use difference lists, here goes one which instead obtains the remainder using same_length/2 + append/3 and with added comments:

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).