2

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.
  1. 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:

Sorting list program

Géry Ogam
  • 6,336
  • 4
  • 38
  • 67

2 Answers2

2

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).
Géry Ogam
  • 6,336
  • 4
  • 38
  • 67
gusbro
  • 22,357
  • 35
  • 46
  • Thanks Gustavo! What do `n-T` and `Items|T` mean? – Géry Ogam Aug 12 '21 at 09:21
  • 1
    I am using the atom n to avoid the procedure to succeed with `List` and `Reminder` being empty lists. So at least one of them must be not empty. – gusbro Aug 12 '21 at 16:13
  • 1
    I am using difference lists to avoid needing to use `append/3` to split the List into the list of deleted Item and the rest of the permuted list. So when I pass `n-T` to `deleted_all/5` the last argument will hold the selected item (possibly repeated N times) with the tail of that list being `T`, which will be further used to complete recursion. – gusbro Aug 12 '21 at 16:19
  • I am still struggling to understand this part. The original predicate `permuted/2` does a *permutation of a list* using a recursive rule definition: a list `U` has a permutation `[V|W]` if `W` is a permutation of the list resulting from deleting the first occurence of `V` from `U`. What does the new predicate `permuted_all/2` do in plain English? – Géry Ogam Aug 12 '21 at 21:27
  • 1
    Let me try to word it in plain english: a list `U` has a permutation `[V|W]` where `W` is a permutation of the list resulting from deleting one occurence of `V` from `U` **and** having any other occurence of `V` before any other element which is not `V`. So if `U` has N (N>0) occurences of `V` then `[U|W]` will be permutations of `U` that begin with N `V`s – gusbro Aug 12 '21 at 21:47
  • I see, so for instance if `U` is `[2, 1, 2]`, while `permuted/2` computes the permutations `[2, 1, 2], [2, 2, 1], [1, 2, 2], [1, 2, 2], [2, 2, 1], [2, 1, 2]`, I expect `permuted_all/2` to only compute the permutations `[2, 2, 1], [2, 2, 1], [1, 2, 2], [1, 2, 2]`. However that is not what I get, `permuted_all/2` actually computes the permutations `[2, 2, 1], [1, 2, 2]`, i.e. it also removes the duplicates. How does it do it? – Géry Ogam Aug 13 '21 at 06:41
  • 1
    If `U` is `[2, 1, 2]` the first call to `permuted_all/2` calls `deleted_all/5` that will bind `V` with `2`, `[V|W]` with `[2,2|T]` and `X` with `[1]`. Then the recursive call now calls `deleted_all/5` which will bind `V` with `1`, `[V|W]` with `[1|T]` and `X` with `[]` and you get the first solution (`[2,2,1]`). – gusbro Aug 13 '21 at 17:51
  • 1
    Upon backtracking it will fall back through the alternative of the first call to `deleted_all/5` which will now bind `V` with `1`, `[V|W]` with `[1|T]` and `X` with `[2,2]`. Then, again, the recursive call is made which will bind `V` with `2`, `[V|W]` with `[2,2|T]` and `X` with `[]` and you then get the second solution `[1,2,2]`. So the idea is that permutations are always done grouping _all_ the ocuccurences of `V` from the current `U`. – gusbro Aug 13 '21 at 17:54
  • So if `U` is `[2, 1, 2]`, `permuted/2` looks at each item and permutes the rest of the list (i.e. for item `2`: `[1, 2]` and `[2, 1]`, for item `1`: `[2, 2]` and `[2, 2]`, and for item `2`: `[2, 1]` and `[1, 2]`, resulting in the permutations `[2, 1, 2], [2, 2, 1], [1, 2, 2], [1, 2, 2], [2, 2, 1], [2, 1, 2]`), while `permuted_all/2` looks at each **set of** items and permutes the rest of the list (i.e. for set of items `[2, 2]`: `[1]`, and for set of item `[1]`: `[2, 2]` and `[2, 2]`, resulting in the permutations `[2, 2, 1], [1, 2, 2], [1, 2, 2]`). Why a single `[1, 2, 2]` in the real result? – Géry Ogam Aug 15 '21 at 13:18
  • I would not call it **set** because it usually implies no duplicates. Thats why I called them **groups**. The algorithm is recursive and applies the same idea to every group. So `permuted_all/2` takes an item `V` and groups all items which are `V` together, then obtains the permutation of the remaining groups recursively. – gusbro Aug 16 '21 at 11:48
  • So for the list `L=[2,1,2]` when it takes the group `[2, 2]` then continue with the recursion with the remaining list `[1]` which only has one permutation left (`[1]`). When it takes the group `[1]` then continues with the recursion with the remaining list `[2, 2]` which again only has one permutation left (`[2, 2]`). Therefore for the list `[2, 1, 2]` it compute two distinct solutions `[1, 2, 2]` and `[2, 1, 1]`. Then `sorted/2` only succeeds for `[1, 2, 2]` which is the one sorted. – gusbro Aug 16 '21 at 11:48
  • You are right, *set* is incorrect, the correct mathematical term is *multiset* (a.k.a. *bag*). `permuted_all/2` actually generates all [permutations of a multiset](https://en.wikipedia.org/wiki/Permutation#Permutations_of_multisets) (the order in the input list is irrelevant so it can be considered as a multiset). And as you explained, it does this by taking each submultiset of identical items (that you called a *group*) and generating permutations with the remaining items. – Géry Ogam Aug 18 '21 at 18:09
  • I get why for `permuted_all/2` the group `[2, 2]` generates the permutation `[1]`. But I still don’t get why the group `[1]` generates a *single* permutation `[2, 2]` instead of *two* permutations `[2, 2]` and `[2, 2]` like for `permuted/2`. How do the extra 4th and 5th arguments of `deleted_all/5` achieve this? As a beginner I am not familiar with [difference lists](https://en.wikipedia.org/wiki/Difference_list) (though I used this opportunity to learn about them) so if you could provide a program that does not rely on them that may help me to fully understand what is happening. – Géry Ogam Aug 18 '21 at 18:22
  • 1
    The use of difference lists in this answer is only to improve efficency (avoiding to use `append/3` between the calls to `deleted_all/5` and `permuted_all/2` to get the remaining part of the list). In the example, when you get the group `[1]` the remaining list `[2, 2]` generates only one permutation because the recursion calls `permuted_all/2` whose productions are only unique groups of same-value items. – gusbro Aug 18 '21 at 18:32
  • 1
    @Maggyero: added a commented version without difference lists at the end of the answer – gusbro Aug 18 '21 at 19:54
  • I have finally got it after looking at the recursion as you suggested. `permuted_all([2, 1, 2], X)` takes each group of same items and does a recursive call on the rest of the list. So it initially takes the first group of same items `[2, 2]` from `[2, 1, 2]` and does a recursive call on `[1]`, which takes the group of same items `[1]` from `[1]` and does a recursive call on `[]`, which halts the computation and gives the first solution: `[2, 2, 1]`. – Géry Ogam Aug 20 '21 at 10:10
  • … Then it takes the second group of same items `[1]` from `[2, 1, 2]` and does a recursive call on `[2, 2]`, which takes the group of same items `[2, 2]` from `[2, 2]` and does a recursive call on `[]`, which halts the computation and gives the second solution: `[1, 2, 2]`. – Géry Ogam Aug 20 '21 at 10:10
  • @Maggyero: I have just rolled back your last changes to my answer because they are not what I expect from those procedures. I do not want to move same_length to where you moved them, they lead to useless computations. You may add another answer with your own changes (and accept your own answer instead of this one if you wish) – gusbro Aug 20 '21 at 17:47
  • Actually I have edited your answer because `permuted_all(X, [2, 1, 2])` does not terminate. – Géry Ogam Aug 20 '21 at 17:48
  • `permuted_all/2` is "internal" to `sorted/2` which already takes care of that non-termination. You had also changed `permuted/3` -> `same_length/2`+`permuted/2` which processes the list every time – gusbro Aug 20 '21 at 18:41
  • Okay, in other words we are optimizing `permuted_all/2` by moving the call to `same_length/2` outside the procedure. That makes sense for an internal procedure. So I have just restored the non controversial part which will hopefully improve this excellent answer. – Géry Ogam Aug 20 '21 at 22:14
  • By the way Gustavo, do you know a way to *embed* `same_length/2` into `permuted_all/2` like you did for `permuted/2`? – Géry Ogam Aug 26 '21 at 16:36
  • You would probably need to embed it from `sorted/2` all the way down to `deleted_all/5` due to the interleaved recursion. – gusbro Aug 26 '21 at 19:17
  • Alright. I am trying but I didn’t find a way yet. – Géry Ogam Aug 26 '21 at 22:03
0

Your second problem can by solved by replacing first line with

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

or

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

The first one is not so easy to solve because of the implementation of this algorithm. Both 1st [1, 1, 2] and 2nd [1, 1, 2] are valid permutations since your code that generated permutations generates all permutations not unique permutations.

Géry Ogam
  • 6,336
  • 4
  • 38
  • 67
Vulwsztyn
  • 2,140
  • 1
  • 12
  • 20
  • Thanks. Note that [cuts should be avoided.](https://stackoverflow.com/a/14556019/2326961) – Géry Ogam Aug 11 '21 at 09:46
  • 1
    @Maggyero Yes but also permutation sort should be avoided. On a scale of 1 to 10 implementing a permutations sort is kinda silly. – TA_intern Aug 11 '21 at 13:05
  • 1
    @TA_intern I agree, but that was not intended for production, only for reproducing the program of an academic paper. – Géry Ogam Aug 12 '21 at 05:38