Find the missing permutation

From Rosetta Code

Jump to: navigation, search
Task
Find the missing permutation
You are encouraged to solve this task according to the task description, using any language you may know.

These are all of the permutations of the symbols A, B, C and D, except for one that's not listed. Find that missing permutation.

ABCD
CABD
ACDB
DACB
BCDA
ACBD
ADCB
CDAB
DABC
BCAD
CADB
CDBA
CBAD
ABDC
ADBC
BDCA
DCBA
BACD
BADC
BDAC
CBDA
DBCA
DCAB

Contents

[edit] AutoHotkey

IncompleteList := "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB"
 
CompleteList := Perm( "ABCD" )
Missing := ""
 
Loop, Parse, CompleteList, `n, `r
If !InStr( IncompleteList , A_LoopField )
Missing .= "`n" A_LoopField
 
MsgBox Missing Permutation(s):%Missing%
 
;-------------------------------------------------
 
; Shortened version of [VxE]'s permutation function
; http://www.autohotkey.com/forum/post-322251.html#322251
Perm( s , dL="" , t="" , p="") {
StringSplit, m, s, % d := SubStr(dL,1,1) , %t%
IfEqual, m0, 1, return m1 d p
Loop %m0%
{
r := m1
Loop % m0-2
x := A_Index + 1, r .= d m%x%
L .= Perm(r, d, t, m%m0% d p)"`n" , mx := m1
Loop % m0-1
x := A_Index + 1, m%A_Index% := m%x%
m%m0% := mx
}
return substr(L, 1, -1)
}

[edit] C

Much of this code duplicates code from Permutation sort task. Here ElementType is a char instead of a char *.

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
 
typedef struct pi *Permutations;
 
typedef char ElementType;
 
struct pi {
short list_size;
short *counts;
ElementType *crntperm;
};
 
Permutations PermutationIterator( const ElementType *list, short listSize)
{
int ix;
Permutations p = malloc(sizeof(struct pi));
p->list_size = listSize;
p->counts = malloc( p->list_size * sizeof(short));
p->crntperm = malloc( p->list_size * sizeof(ElementType));
 
for (ix=0; ix<p->list_size; ix++) {
p->counts[ix] = ix;
p->crntperm[ix] = list[ix];
}
return p;
}
 
void FreePermutations( Permutations p)
{
if (NULL == p) return;
if (p->crntperm) free(p->crntperm);
if (p->counts) free(p->counts);
free(p);
}
#define FREE_Permutations(pi) do {\
FreePermutations(pi); pi=NULL; } while(0)

 
 
ElementType *FirstPermutation(Permutations p)
{
return p->crntperm;
}
 
ElementType *NextPermutation( Permutations p)
{
int ix, j;
ElementType *crntp, t;
 
crntp = p->crntperm;
ix = 1;
do {
t = crntp[0];
for(j=0; j<ix; j++) crntp[j] = crntp[j+1];
crntp[ix] = t;
if (p->counts[ix] > 0) break;
ix += 1;
} while (ix < p->list_size);
if (ix == p->list_size) return NULL;
 
p->counts[ix] -= 1;
while(--ix) {
p->counts[ix] = ix;
}
return crntp;
}
 
static const char *pmList[] = {
"ABCD","CABD","ACDB","DACB",
"BCDA","ACBD","ADCB","CDAB",
"DABC","BCAD","CADB","CDBA",
"CBAD","ABDC","ADBC","BDCA",
"DCBA","BACD","BADC","BDAC",
"CBDA","DBCA","DCAB" };
#define LISTSIZE (sizeof(pmList)/sizeof(pmList[0]))
 
int main( )
{
short size =4;
ElementType *prm;
ElementType mx[] = "ABCD";
int k;
char ss[8];
 
Permutations pi = PermutationIterator(mx, size);
for ( prm = FirstPermutation(pi); prm; prm = NextPermutation(pi)) {
strncpy(ss, prm, 4); ss[4] = 0;
for (k=0; k<LISTSIZE; k++) {
if (0 == strcmp(pmList[k], ss)) break;
}
if (k==LISTSIZE) {
printf("Permutation %s was not in list\n", ss);
break;
}
}
 
FreePermutations( pi);
return 0;
}

[edit] C++

#include <algorithm>
#include <vector>
#include <set>
#include <iterator>
#include <iostream>
#include <string>
 
static const std::string GivenPermutations[] = {
"ABCD","CABD","ACDB","DACB",
"BCDA","ACBD","ADCB","CDAB",
"DABC","BCAD","CADB","CDBA",
"CBAD","ABDC","ADBC","BDCA",
"DCBA","BACD","BADC","BDAC",
"CBDA","DBCA","DCAB"
};
static const size_t NumGivenPermutations = sizeof(GivenPermutations) / sizeof(*GivenPermutations);
 
int main()
{
std::vector<std::string> permutations;
std::string initial = "ABCD";
permutations.push_back(initial);
 
while(true)
{
std::string p = permutations.back();
std::next_permutation(p.begin(), p.end());
if(p == permutations.front())
break;
permutations.push_back(p);
}
 
std::vector<std::string> missing;
std::set<std::string> given_permutations(GivenPermutations, GivenPermutations + NumGivenPermutations);
std::set_difference(permutations.begin(), permutations.end(), given_permutations.begin(),
given_permutations.end(), std::back_inserter(missing));
std::copy(missing.begin(), missing.end(), std::ostream_iterator<std::string>(std::cout, "\n"));
return 0;
}

[edit] C#

Works with: C# version 2+

using System;
using System.Collections.Generic;
 
namespace MissingPermutation
{
class Program
{
static void Main()
{
string[] given = new string[] { "ABCD", "CABD", "ACDB", "DACB",
"BCDA", "ACBD", "ADCB", "CDAB",
"DABC", "BCAD", "CADB", "CDBA",
"CBAD", "ABDC", "ADBC", "BDCA",
"DCBA", "BACD", "BADC", "BDAC",
"CBDA", "DBCA", "DCAB" };
 
List<string> result = new List<string>();
permuteString(ref result, "", "ABCD");
 
foreach (string a in result)
if (Array.IndexOf(given, a) == -1)
Console.WriteLine(a + " is a missing Permutation");
}
 
public static void permuteString(ref List<string> result, string beginningString, string endingString)
{
if (endingString.Length <= 1)
{
result.Add(beginningString + endingString);
}
else
{
for (int i = 0; i < endingString.Length; i++)
{
string newString = endingString.Substring(0, i) + endingString.Substring(i + 1);
permuteString(ref result, beginningString + (endingString.ToCharArray())[i], newString);
}
}
}
}
}

[edit] Clojure

 
(use 'clojure.contrib.combinatorics)
(use 'clojure.set)
 
(def given (apply hash-set (partition 4 5 "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB" )))
(def s1 (apply hash-set (permutations "ABCD")))
(def missing (difference s1 given))
 

[edit] Common Lisp

(defparameter *permutations*
'("ABCD" "CABD" "ACDB" "DACB" "BCDA" "ACBD" "ADCB" "CDAB" "DABC" "BCAD" "CADB" "CDBA"
"CBAD" "ABDC" "ADBC" "BDCA" "DCBA" "BACD" "BADC" "BDAC" "CBDA" "DBCA" "DCAB"))
 
(defun missing-perm (perms)
(let* ((letters (loop for i across (car perms) collecting i))
(l (/ (1+ (length perms)) (length letters))))
(labels ((enum (n) (loop for i below n collecting i))
(least-occurs (pos)
(let ((occurs (loop for i in perms collecting (aref i pos))))
(cdr (assoc (1- l) (mapcar #'(lambda (letter)
(cons (count letter occurs) letter))
letters))))))
(concatenate 'string (mapcar #'least-occurs (enum (length letters)))))))

Output:

ROSETTA> (missing-perm *permutations*)
"DBAC"

[edit] D

Works with: D version 2

import std.stdio, std.string;
 
T[][] permutations(T)(T[] items) {
T[][] result;
 
void perms(T[] s, T[] prefix=[]) {
if (s.length)
foreach (i, c; s)
perms(s[0 .. i] ~ s[i+1 .. $], prefix ~ c);
else
result ~= prefix;
}
 
perms(items);
return result;
}
 
void main() {
auto given = "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB"
.split();
 
int[string] givenSet;
foreach (s; given)
givenSet[s] = 0;
 
foreach (p; permutations("ABCD"))
if (p !in givenSet)
writeln(p);
}

[edit] Fortran

Work-around to let it run properly with some bugged versions (e.g. 4.3.2) of gfortran: remove the parameter attribute to the array list.

program missing_permutation
 
implicit none
character (4), dimension (23), parameter :: list = &
& (/'ABCD', 'CABD', 'ACDB', 'DACB', 'BCDA', 'ACBD', 'ADCB', 'CDAB', &
& 'DABC', 'BCAD', 'CADB', 'CDBA', 'CBAD', 'ABDC', 'ADBC', 'BDCA', &
& 'DCBA', 'BACD', 'BADC', 'BDAC', 'CBDA', 'DBCA', 'DCAB'/)
integer :: i, j, k
 
do i = 1, 4
j = minloc ((/(count (list (:) (i : i) == list (1) (k : k)), k = 1, 4)/), 1)
write (*, '(a)', advance = 'no') list (1) (j : j)
end do
write (*, *)
 
end program missing_permutation

Output:

DBAC

[edit] Haskell

Works with: GHC version 6.10+

import Data.List
import Control.Monad
import Control.Arrow
 
deficientPermsList =
["ABCD","CABD","ACDB","DACB",
"BCDA","ACBD","ADCB","CDAB",
"DABC","BCAD","CADB","CDBA",
"CBAD","ABDC","ADBC","BDCA",
"DCBA","BACD","BADC","BDAC",
"CBDA","DBCA","DCAB"]
 
missingPerm :: (Eq a) => [[a]] -> [[a]]
missingPerm = (\\) =<< permutations . nub. join

Use:

missingPerm deficientPermsList

[edit] Icon and Unicon

[edit] Icon

link strings    # for permutes
 
procedure main()
givens := set![ "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB",
"CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"]
 
every insert(full := set(), permutes("ABCD")) # generate all permutations
givens := full--givens # and difference
 
write("The difference is : ")
every write(!givens, " ")
end

The approach above generates a full set of permutations and calculates the difference. Changing the two commented lines to the three below will calculate on the fly and would be more efficient for larger data sets.

every x := permutes("ABCD") do                    # generate all permutations 
if member(givens,x) then delete(givens,x) # remove givens as they are generated
else insert(givens,x) # add back any not given

A still more efficient version is:

link strings
 
procedure main()
givens := set("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD",
"ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA",
"CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD",
"BADC", "BDAC", "CBDA", "DBCA", "DCAB")
 
every p := permutes("ABCD") do
if not member(givens, p) then write(p)
 
end

Library: Icon Programming Library member 'strings' provides permutes(s) which generates all permutations of a string

[edit] Unicon

The Icon solutions work in Unicon.

[edit] J

Solution:

permutations=: A.~ i.@!@#
missingPerms=: -.~ permutations @ {.

Use:

data=: >;: 'ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA'
data=: data,>;: 'CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB'

   missingPerms data
DBAC

[edit] Alternatives

Or the above could be a single definition that works the same way:

missingPerms=: -.~ (A.~ i.@!@#) @ {.   

Or the equivalent explicit (cf. tacit above) definition:

missingPerms=: monad define
item=. {. y
y -.~ item A.~ i.! #item
)

Or, the solution could be obtained without defining an independent program:

   data -.~ 'ABCD' A.~ i.!4
DBAC

Here, 'ABCD' represents the values being permuted (their order does not matter), and 4 is how many of them we have.

Yet another alternative expression, which uses parentheses instead of the passive operator (~), would be:

   ((i.!4) A. 'ABCD') -. data
DBAC

[edit] JavaScript

The permute() function taken from http://snippets.dzone.com/posts/show/1032

permute = function(v, m){ //v1.0
for(var p = -1, j, k, f, r, l = v.length, q = 1, i = l + 1; --i; q *= i);
for(x = [new Array(l), new Array(l), new Array(l), new Array(l)], j = q, k = l + 1, i = -1;
++i < l; x[2][i] = i, x[1][i] = x[0][i] = j /= --k);
for(r = new Array(q); ++p < q;)
for(r[p] = new Array(l), i = -1; ++i < l; !--x[1][i] && (x[1][i] = x[0][i],
x[2][i] = (x[2][i] + 1) % l), r[p][i] = m ? x[3][i] : v[x[3][i]])
for(x[3][i] = x[2][i], f = 0; !f; f = !f)
for(j = i; j; x[3][--j] == x[2][i] && (x[3][i] = x[2][i] = (x[2][i] + 1) % l, f = 1));
return r;
};
 
list = [ 'ABCD', 'CABD', 'ACDB', 'DACB', 'BCDA', 'ACBD', 'ADCB', 'CDAB',
'DABC', 'BCAD', 'CADB', 'CDBA', 'CBAD', 'ABDC', 'ADBC', 'BDCA',
'DCBA', 'BACD', 'BADC', 'BDAC', 'CBDA', 'DBCA', 'DCAB'];
 
all = permute(list[0].split('')).map(function(elem) {return elem.join('')});
 
missing = all.filter(function(elem) {return list.indexOf(elem) == -1});
print(missing); // ==> DBAC

[edit] MATLAB

This solution is designed to work on a column vector of strings. This will not work with a cell array or row vector of strings.

function perm = findMissingPerms(list)
 
permsList = perms(list(1,:)); %Generate all permutations of the 4 letters
perm = []; %This is the functions return value if the list is not missing a permutation
 
%Normally the rest of this would be vectorized, but because this is
%done on a vector of strings, the vectorized functions will only access
%one character at a time. So, in order for this to work we have to use
%loops.
for i = (1:size(permsList,1))
 
found = false;
 
for j = (1:size(list,1))
if (permsList(i,:) == list(j,:))
found = true;
break
end
end
 
if not(found)
perm = permsList(i,:);
return
end
 
end %for
end %fingMissingPerms

Output:

>> list = ['ABCD';
'CABD';
'ACDB';
'DACB';
'BCDA';
'ACBD';
'ADCB';
'CDAB';
'DABC';
'BCAD';
'CADB';
'CDBA';
'CBAD';
'ABDC';
'ADBC';
'BDCA';
'DCBA';
'BACD';
'BADC';
'BDAC';
'CBDA';
'DBCA';
'DCAB']
 
list =
 
ABCD
CABD
ACDB
DACB
BCDA
ACBD
ADCB
CDAB
DABC
BCAD
CADB
CDBA
CBAD
ABDC
ADBC
BDCA
DCBA
BACD
BADC
BDAC
CBDA
DBCA
DCAB
 
>> findMissingPerms(list)
 
ans =
 
DBAC


[edit] OCaml

some utility functions:

(* insert x at all positions into li and return the list of results *)
let rec insert x li = match li with
| [] -> [[x]]
| a::m -> (x::li) :: (List.map (fun y -> a::y) (insert x m))
 
(* list of all permutations of li *)
let rec permutations li = match li with
| a::m -> List.flatten (List.map (insert a) (permutations m))
| _ -> [li]
 
(* convert a string to a char list *)
let chars_of_string s =
let cl = ref [] in
String.iter (fun c -> cl := c :: !cl) s;
(List.rev !cl)
 
(* convert a char list to a string *)
let string_of_chars cl =
String.concat "" (List.map (String.make 1) cl)

resolve the task:

let deficient_perms = [
"ABCD";"CABD";"ACDB";"DACB";
"BCDA";"ACBD";"ADCB";"CDAB";
"DABC";"BCAD";"CADB";"CDBA";
"CBAD";"ABDC";"ADBC";"BDCA";
"DCBA";"BACD";"BADC";"BDAC";
"CBDA";"DBCA";"DCAB";
]
 
let it = chars_of_string (List.hd deficient_perms)
 
let perms = List.map string_of_chars (permutations it)
 
let results = List.filter (fun v -> not(List.mem v deficient_perms)) perms
 
let () = List.iter print_endline results


[edit] Oz

Using constraint programming for this problem may be a bit overkill...

declare
GivenPermutations =
["ABCD" "CABD" "ACDB" "DACB" "BCDA" "ACBD" "ADCB" "CDAB" "DABC" "BCAD" "CADB" "CDBA"
"CBAD" "ABDC" "ADBC" "BDCA" "DCBA" "BACD" "BADC" "BDAC" "CBDA" "DBCA" "DCAB"]
 
%% four distinct variables between "A" and "D":
proc {Description Root}
Root = {FD.list 4 &A#&D}
{FD.distinct Root}
{FD.distribute naiv Root}
end
 
AllPermutations = {SearchAll Description}
in
for P in AllPermutations do
if {Not {Member P GivenPermutations}} then
{System.showInfo "Missing: "#P}
end
end

[edit] PHP

<?php
$finalres = Array();
function permut($arr,$result=array()){
global $finalres;
if(empty($arr)){
$finalres[] = implode("",$result);
}else{
foreach($arr as $key => $val){
$newArr = $arr;
$newres = $result;
$newres[] = $val;
unset($newArr[$key]);
permut($newArr,$newres);
}
}
}
$givenPerms = Array("ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB","DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA","DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB");
$given = Array("A","B","C","D");
permut($given);
print_r(array_diff($finalres,$givenPerms)); // Array ( [20] => DBAC )
 

[edit] Perl

Because the set of all permutations contains all its own rotations, the first missing rotation is the target.

sub check_perm {
my %hash; @hash{@_} = ();
for my $s (@_) { exists $hash{$_} or return $_
for map substr($s,1) . substr($s,0,1), (1..length $s); }
}
 
# Check and display
@perms = qw(ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB);
print check_perm(@perms), "\n";

Output:

DBAC

[edit] Perl 6

Tested using Rakudo #25 Minneapolis.

# The givens from Rosetta Code:
my @givens = "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB";
 
# Get all the unique permutations of ABCD
my @letters = <A B C D>;
my @perms = (@letters X~ @letters X~ @letters X~ @letters).grep: {
.chars == .split('').uniq.elems
};
 
# Print out the missing value:
for @perms {
.say if $_ eq none(@givens);
}

Of course, all of these solutions are working way too hard, when you can just xor all the bits, and the missing one will just pop right out:

say [~^] @givens;
DBAC

[edit] PicoLisp

(setq *PermList
(mapcar chop
(quote
"ABCD" "CABD" "ACDB" "DACB" "BCDA" "ACBD" "ADCB" "CDAB"
"DABC" "BCAD" "CADB" "CDBA" "CBAD" "ABDC" "ADBC" "BDCA"
"DCBA" "BACD" "BADC" "BDAC" "CBDA" "DBCA" "DCAB" ) ) )
 
(let (Lst (chop "ABCD") L Lst)
(recur (L) # Permute
(if (cdr L)
(do (length L)
(recurse (cdr L))
(rot L) )
(unless (member Lst *PermList) # Check
(prinl Lst) ) ) ) )

Output:

DBAC

[edit] PureBasic

Procedure in_List(in.s)
Define.i i, j
Define.s a
Restore data_to_test
For i=1 To 3*8-1
Read.s a
If in=a
ProcedureReturn #True
EndIf
Next i
ProcedureReturn #False
EndProcedure
 
Define.c z, x, c, v
If OpenConsole()
For z='A' To 'D'
For x='A' To 'D'
If z=x:Continue:EndIf
For c='A' To 'D'
If c=x Or c=z:Continue:EndIf
For v='A' To 'D'
If v=c Or v=x Or v=z:Continue:EndIf
Define.s test=Chr(z)+Chr(x)+Chr(c)+Chr(v)
If Not in_List(test)
PrintN(test+" is missing.")
EndIf
Next
Next
Next
Next
PrintN("Press Enter to exit"):Input()
EndIf
 
DataSection
data_to_test:
Data.s "ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB"
Data.s "DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA"
Data.s "DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB"
EndDataSection

Output

DBAC is missing.

[edit] Python

Works with: Python version 2.6+

from itertools import permutations
 
given = '''ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB'
''.split()
 
allPerms = [''.join(x) for x in permutations(given[0])]
 
missing = list(set(allPerms) - set(given)) # ['DBAC']

[edit] R

This uses the "combinat" package, which is a standard R package:

 
library(combinat)
 
permute.me <- c("A", "B", "C", "D")
perms <- permn(permute.me) # list of all permutations
perms2 <- matrix(unlist(perms), ncol=length(permute.me), byrow=T) # matrix of all permutations
perms3 <- apply(perms2, 1, paste, collapse="") # vector of all permutations
 
incomplete <- c("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB",
"DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA",
"DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB")
 
setdiff(perms3, incomplete)
 

Output:

 
[1] "DBAC"
 

[edit] Ruby

Works with: Ruby version 1.8.7+

given = %w{
ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB
}
 
all = given[0].split(//).permutation.collect {|perm| perm.join('')}
 
missing = all - given # ["DBAC"]

[edit] Scala

Works with: Scala version 2.8

def fat(n: Int) = (2 to n).foldLeft(1)(_*_)
def perm[A](x: Int, a: Seq[A]): Seq[A] = if (x == 0) a else {
val n = a.size
val fatN1 = fat(n - 1)
val fatN = fatN1 * n
val p = x / fatN1 % fatN
val (before, Seq(el, after @ _*)) = a splitAt p
el +: perm(x % fatN1, before ++ after)
}
def findMissingPerm(start: String, perms: Array[String]): String = {
for {
i <- 0 until fat(start.size)
p = perm(i, start).mkString
} if (!perms.contains(p)) return p
""
}
val perms = """ABCD
CABD
ACDB
DACB
BCDA
ACBD
ADCB
CDAB
DABC
BCAD
CADB
CDBA
CBAD
ABDC
ADBC
BDCA
DCBA
BACD
BADC
BDAC
CBDA
DBCA
DCAB"
"".stripMargin.split("\n")
println(findMissingPerm(perms(0), perms))

[edit] Tcl

Library: tcllib

package require struct::list
package require struct::set
 
# Make complete list of permutations of a string of characters
proc allCharPerms s {
set perms {}
set p [struct::list firstperm [split $s {}]]
while {$p ne ""} {
lappend perms [join $p {}]
set p [struct::list nextperm $p]
}
return $perms
}
 
# The set of provided permutations (wrapped for convenience)
set have {
ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC
ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB
}
# Get the real list of permutations...
set all [allCharPerms [lindex $have 0]]
# Find the missing one(s)!
set missing [struct::set difference $all $have]
puts "missing permutation(s): $missing"

Outputs

missing permutation(s): DBAC

I prefer to wrap the raw permutation generator up though:

package require struct::list
package require struct::set
 
proc foreachPermutation {varName listToPermute body} {
upvar 1 $varName v
set p [struct::list firstperm $listToPermute]
for {} {$p ne ""} {set p [struct::list nextperm $p]} {
set v $p; uplevel 1 $body
}
}
 
proc findMissingCharPermutations {set} {
set all {}
foreachPermutation charPerm [split [lindex $set 0] {}] {
lappend all [join $charPerm {}]
}
return [struct::set difference $all $set]
}
 
set have {
ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC
ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB
}
set missing [findMissingCharPermutations $have]

[edit] Ursala

The permutation generating function is imported from the standard library below and needn't be reinvented, but its definition is shown here in the interest of comparison with other solutions.

permutations = ~&itB^?a\~&aNC *=ahPfatPRD refer ^C/~&a ~&ar&& ~&arh2falrtPXPRD

The ~&j operator computes set differences.

#import std
#show+
 
main =
 
~&j/permutations'ABCD' -[
ABCD
CABD
ACDB
DACB
BCDA
ACBD
ADCB
CDAB
DABC
BCAD
CADB
CDBA
CBAD
ABDC
ADBC
BDCA
DCBA
BACD
BADC
BDAC
CBDA
DBCA
DCAB]-

output:

DBAC
Personal tools
Support