Find the missing permutation: Difference between revisions
(→{{header|REXX}}: condensed the REXX program to not use a subroutine and other structural changes. -- ~~~~) |
|||
Line 1,115: | Line 1,115: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
⚫ | |||
<lang rexx> |
|||
⚫ | |||
list='ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA', |
|||
list='ABCD', |
|||
'CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB' |
|||
'CABD', |
|||
'ACDB', |
|||
'DACB', |
|||
'BCDA', |
|||
'ACBD', |
|||
'ADCB', |
|||
'CDAB', |
|||
'DABC', |
|||
'BCAD', |
|||
'CADB', |
|||
'CDBA', |
|||
'CBAD', |
|||
'ABDC', |
|||
'ADBC', |
|||
'BDCA', |
|||
'DCBA', |
|||
'BACD', |
|||
'BADC', |
|||
'BDAC', |
|||
'CBDA', |
|||
'DBCA', |
|||
'DCAB' |
|||
@.=; @abcU='ABCDEFGUIJKLMNOPQRSTUVWXYZ' |
|||
@.='' |
|||
things=4 |
things=4 |
||
bunch=4 |
bunch=4 |
||
⚫ | |||
@abc='abcdefguijklmnopqrstuvwxyz' |
|||
⚫ | |||
@abcu=@abc; upper @abcu |
|||
end /*j*/ |
|||
⚫ | |||
⚫ | |||
⚫ | |||
end |
|||
!='$. @. bunch list things' |
|||
⚫ | |||
exit |
exit |
||
/*─────────────────────────────────────PERMSET subroutine───────────────*/ |
|||
⚫ | |||
if ?>bunch then do; _=@.1; do m=2 to bunch |
|||
⚫ | |||
_=_||@.m |
|||
if ?>bunch then call chkMissing |
|||
end /*m*/ |
|||
if wordpos(_,list)==0 then say _ ' is missing from the list.' |
|||
end |
|||
else do x=1 for things /*construction a new permuation. */ |
|||
do k=1 for ?-1; if @.k==$.x then iterate x; end /*k*/ |
|||
@.?=$.x |
@.?=$.x |
||
call permset |
call permset ?+1 |
||
end |
end /*x*/ |
||
return |
return</lang> |
||
'''output''' |
|||
chkMissing: _=@.1 |
|||
do j=2 to bunch |
|||
_=_||@.j |
|||
end |
|||
if wordpos(_,list)==0 then say _ 'is missing from the list.' |
|||
return |
|||
</lang> |
|||
Output: |
|||
<pre style="height:5ex;overflow:scroll"> |
<pre style="height:5ex;overflow:scroll"> |
||
DBAC is missing from the list. |
DBAC is missing from the list. |
||
</pre> |
</pre> |
||
Revision as of 13:35, 16 May 2012
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.
(c.f. Permutations)
There is an obvious method : enumerating all permutations of A, B, C, D, and looking for the missing one. There is an alternate method. Hint : if all permutations were here, how many times would A appear in each position ? What is the parity of this number ?
ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB
Ada
<lang Ada>with Ada.Text_IO; procedure Missing_Permutations is
subtype Permutation_Character is Character range 'A' .. 'D';
Character_Count : constant := 1 + Permutation_Character'Pos (Permutation_Character'Last) - Permutation_Character'Pos (Permutation_Character'First);
type Permutation_String is array (1 .. Character_Count) of Permutation_Character;
procedure Put (Item : Permutation_String) is begin for I in Item'Range loop Ada.Text_IO.Put (Item (I)); end loop; end Put;
Given_Permutations : array (Positive range <>) of Permutation_String := ("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB");
Count : array (Permutation_Character, 1 .. Character_Count) of Natural := (others => (others => 0)); Max_Count : Positive := 1;
Missing_Permutation : Permutation_String;
begin
for I in Given_Permutations'Range loop for Pos in 1 .. Character_Count loop Count (Given_Permutations (I) (Pos), Pos) := Count (Given_Permutations (I) (Pos), Pos) + 1; if Count (Given_Permutations (I) (Pos), Pos) > Max_Count then Max_Count := Count (Given_Permutations (I) (Pos), Pos); end if; end loop; end loop;
for Char in Permutation_Character loop for Pos in 1 .. Character_Count loop if Count (Char, Pos) < Max_Count then Missing_Permutation (Pos) := Char; end if; end loop; end loop;
Ada.Text_IO.Put_Line ("Missing Permutation:"); Put (Missing_Permutation);
end Missing_Permutations;</lang>
AutoHotkey
<lang 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)
}</lang>
C
<lang C>#include <stdio.h>
- define N 4
char *perms[] = { "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB", };
int main() { int i, j, n, cnt[N]; char miss[N];
for (n = i = 1; i < N; i++) n *= i; /* n = (N-1)!, # of occurence */
for (i = 0; i < N; i++) { for (j = 0; j < N; j++) cnt[j] = 0;
/* count how many times each letter occur at postion i */ for (j = 0; j < sizeof(perms)/sizeof(char*); j++) cnt[perms[j][i] - 'A']++;
/* letter not occuring (N-1)! times is the missing one */ for (j = 0; j < N && cnt[j] == n; j++);
miss[i] = j + 'A'; } printf("Missing: %.*s\n", N, miss);
return 0;
}</lang>output
Missing: DBAC
C++
<lang Cpp>#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;
}</lang>
C#
<lang csharp>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); } } } }
}</lang>
Clojure
<lang 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)) </lang>
CoffeeScript
<lang coffeescript> missing_permutation = (arr) ->
# Find the missing permutation in an array of N! - 1 permutations.
# We won't validate every precondition, but we do have some basic # guards. if arr.length == 0 throw Error "Need more data" if arr.length == 1 return [arr[0][1] + arr[0][0]] # Now we know that for each position in the string, elements should appear # an even number of times (N-1 >= 2). We can use a set to detect the element appearing # an odd number of times. Detect odd occurrences by toggling admission/expulsion # to and from the set for each value encountered. At the end of each pass one element # will remain in the set. result = for pos in [0...arr[0].length] set = {} for permutation in arr c = permutation[pos] if set[c] delete set[c] else set[c] = true for c of set result += c break result
given = ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB
arr = (s for s in given.replace('\n', ' ').split ' ' when s != )
console.log missing_permutation(arr) </lang>
Output: <lang>
> coffee missing_permute.coffee
DBAC </lang>
Common Lisp
<lang 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)))))))</lang>
Output:
ROSETTA> (missing-perm *permutations*) "DBAC"
D
<lang D>import std.stdio, std.string;
T[][] permutations(T)(in T[] items) pure nothrow {
T[][] result;
void perms(in T[] s, T[] prefix=[]) nothrow { 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() {
const 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();
bool[string] givenSet; foreach (s; given) givenSet[s] = true;
foreach (p; permutations("ABCD")) if (p !in givenSet) writeln(p);
}</lang>
Alternative Versions
<lang d>import std.stdio, std.string, std.algorithm, std.conv;
void main() {
const perms = "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB".split();
// Version 1: XOR all the ASCII values, the uneven one gets // flushed out; based on Perl 6 (via Go) ubyte[4] b; foreach (perm; perms) foreach (i, c; perm) b[i] ^= c; writeln(cast(char[])b);
// Version 2 : Sum ASCII values auto sumr = perms[0].reduce!q{a + b}(); // sum row foreach (i; 0 .. 4) { // sum columns const sumc = reduce!((a,b)=> text(to!int(a) + b[i]))("0",perms); // see how much it falls short write(cast(char)(sumr - to!int(sumc) % sumr)); } writeln();
// Version 3: some sort of checksum, don't ask // me: translation of Java enum int len = 4; int maxCode = len - 1; foreach_reverse (i; 3 .. len + 1) maxCode *= i; // maxCode will be 36 foreach (i; 0 .. len) { int code = 0; foreach (p; perms) code += perms[0].countUntil(p[i]);
// code will come up 3, 1, 0, 2 short of 36 write(cast(char)perms[0][maxCode - code]); }
}</lang>
- Output:
DBAC DBAC DBAC
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. <lang fortran>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</lang> Output:
DBAC
GAP
<lang gap># our deficient list L := [ "ABCD", "CABD", "ACDB", "DACB", "BCDA",
"ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB" ];
- convert L to permutations on 1..4
u := List(L, s -> List([1..4], i -> Position("ABCD", s[i])));
- set difference (with all permutations)
v := Difference(PermutationsList([1..4]), u);
- convert back to letters
s := "ABCD"; List(v, p -> List(p, i -> s[i]));</lang>
Go
Alternate method suggested by task description: <lang go>package main
import (
"fmt" "strings"
)
var given = strings.Split(`ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB`, "\n")
func main() {
b := make([]byte, len(given[0])) for i := range b { m := make(map[byte]int) for _, p := range given { m[p[i]]++ } for char, count := range m { if count&1 == 1 { b[i] = char break } } } fmt.Println(string(b))
}</lang> Xor method suggested by Perl 6 contributor: <lang go>func main() {
b := make([]byte, len(given[0])) for _, p := range given { for i, c := range []byte(p) { b[i] ^= c } } fmt.Println(string(b))
}</lang> Output in either case:
DBAC
Groovy
Solution: <lang groovy>def fact = { n -> [1,(1..<(n+1)).inject(1) { prod, i -> prod * i }].max() } def missingPerms missingPerms = {List elts, List perms ->
perms.empty ? elts.permutations() : elts.collect { e -> def ePerms = perms.findAll { e == it[0] }.collect { it[1..-1] } ePerms.size() == fact(elts.size() - 1) ? [] \ : missingPerms(elts - e, ePerms).collect { [e] + it } }.sum()
}</lang>
Test: <lang groovy>def e = 'ABCD' as List def p = ['ABCD', 'CABD', 'ACDB', 'DACB', 'BCDA', 'ACBD', 'ADCB', 'CDAB', 'DABC', 'BCAD', 'CADB', 'CDBA',
'CBAD', 'ABDC', 'ADBC', 'BDCA', 'DCBA', 'BACD', 'BADC', 'BDAC', 'CBDA', 'DBCA', 'DCAB'].collect { it as List }
def mp = missingPerms(e, p) mp.each { println it }</lang>
Output:
[D, B, A, C]
Haskell
<lang haskell>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</lang> Use:
missingPerm deficientPermsList
Icon and Unicon
<lang 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</lang>
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.
<lang Icon>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</lang>
A still more efficient version is: <lang Icon>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</lang>
member 'strings' provides permutes(s) which generates all permutations of a string
J
Solution: <lang J>permutations=: A.~ i.@!@# missingPerms=: -.~ permutations @ {.</lang> 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
Alternatives
Or the above could be a single definition that works the same way:
<lang J>missingPerms=: -.~ (A.~ i.@!@#) @ {. </lang>
Or the equivalent explicit (cf. tacit above) definition: <lang J>missingPerms=: monad define
item=. {. y y -.~ item A.~ i.! #item
)</lang>
Or, the solution could be obtained without defining an independent program:
<lang J> data -.~ 'ABCD' A.~ i.!4 DBAC</lang>
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:
<lang J> ((i.!4) A. 'ABCD') -. data DBAC</lang>
Java
optimized Following needs: Utils.java
<lang java>import java.util.ArrayList;
import com.google.common.base.Joiner; import com.google.common.collect.ImmutableSet; import com.google.common.collect.Lists;
public class FindMissingPermutation { public static void main(String[] args) { Joiner joiner = Joiner.on("").skipNulls(); ImmutableSet<String> s = ImmutableSet.of("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB");
for (ArrayList<Character> cs : Utils.Permutations(Lists.newArrayList( 'A', 'B', 'C', 'D'))) if (!s.contains(joiner.join(cs))) System.out.println(joiner.join(cs)); } }</lang>
Output:
DBAC
Alternate version, based on checksumming each position:
<lang java>public class FindMissingPermutation {
public static void main(String[] args) { 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" }; String characterSet = givenPermutations[0]; // Compute n! * (n - 1) / 2 int maxCode = characterSet.length() - 1; for (int i = characterSet.length(); i >= 3; i--) maxCode *= i; StringBuilder missingPermutation = new StringBuilder(); for (int i = 0; i < characterSet.length(); i++) { int code = 0; for (String permutation : givenPermutations) code += characterSet.indexOf(permutation.charAt(i)); missingPermutation.append(characterSet.charAt(maxCode - code)); } System.out.println("Missing permutation: " + missingPermutation.toString()); }
}</lang>
JavaScript
The permute() function taken from http://snippets.dzone.com/posts/show/1032 <lang javascript>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</lang>
K
<lang K> split:{1_'(&x=y)_ x:y,x}
g: ("ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB") g,:(" CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB") p: split[g;" "];
/ All permutations of "ABCD" perm:{:[1<x;,/(>:'(x,x)#1,x#0)[;0,'1+_f x-1];,!x]} p2:a@(perm(#a:"ABCD"));
/ Which permutations in p are there in p2? p2 _lin p
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1
/ Invert the result ~p2 _lin p
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
/ It's the 20th permutation that is missing &~p2 _lin p
,20
p2@&~p2 _lin p
"DBAC"</lang>
Alternative approach: <lang K> table:{b@<b:(x@*:'a),'#:'a:=x}
,/"ABCD"@&:'{5=(table p[;x])[;1]}'!4
"DBAC"</lang>
Mathematica
<lang Mathematica>ProvidedSet = {"ABCD" , "CABD" , "ACDB" , "DACB" , "BCDA" , "ACBD", "ADCB" , "CDAB", "DABC", "BCAD" , "CADB", "CDBA" , "CBAD" , "ABDC", "ADBC" , "BDCA", "DCBA" , "BACD", "BADC", "BDAC" , "CBDA", "DBCA", "DCAB"}
Part[Complement[ Map[ StringJoin , Permutations[Characters[RandomChoice[ProvidedSet]]]], ProvidedSet], 1]
->"DBAC"</lang>
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.
<lang MATLAB>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</lang>
Output: <lang MATLAB>>> 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</lang>
OCaml
some utility functions: <lang ocaml>(* insert x at all positions into li and return the list of results *) let rec insert x = function
| [] -> x | a::m as li -> (x::li) :: (List.map (fun y -> a::y) (insert x m))
(* list of all permutations of li *) let permutations li =
List.fold_right (fun a z -> List.concat (List.map (insert a) z)) 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)</lang>
resolve the task:
<lang ocaml>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</lang>
Alternate method : if we had all permutations, each letter would appear an even number of times at each position. Since there is only one permutation missing, we can find where each letter goes by looking at the parity of the number of occurences of each letter. The following program works with permutations of at least 3 letters. <lang ocaml>let array_of_perm s = let n = String.length s in Array.init n (fun i -> int_of_char s.[i] - 65);;
let perm_of_array a = let n = Array.length a in let s = String.create n in Array.iteri (fun i x -> s.[i] <- char_of_int (x + 65) ) a; s;;
let find_missing v = let n = String.length (List.hd v) in let a = Array.make_matrix n n 0 and r = ref v in List.iter (fun s -> let u = array_of_perm s in Array.iteri (fun i x -> x.(u.(i)) <- x.(u.(i)) + 1) a ) v; let q = Array.make n 0 in Array.iteri (fun i x -> Array.iteri (fun j y -> if y mod 2 != 0 then q.(i) <- j ) x ) a; perm_of_array q;;
find_missing deficient_perms;; (* - : string = "DBAC" *)</lang>
Oz
Using constraint programming for this problem may be a bit overkill...
<lang oz>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</lang>
PHP
<lang 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 ) </lang>
Perl
Because the set of all permutations contains all its own rotations, the first missing rotation is the target.
<lang Perl>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";</lang>
Output:
DBAC
Perl 6
Tested using Rakudo #25 Minneapolis.
<lang perl6># 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); }</lang> 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: <lang perl6>say [~^] @givens; DBAC</lang>
PicoLisp
<lang 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) ) ) ) )</lang>
Output:
DBAC
PureBasic
<lang 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</lang>
Based on the [Permutations] task the solution could be: <lang PureBasic>If OpenConsole()
NewList a.s() findPermutations(a(), "ABCD", 4) ForEach a() Select a() Case "ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB","DABC" Case "BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA","DCBA","BACD" Case "BADC","BDAC","CBDA","DBCA","DCAB" Default PrintN(A()+" is missing.") EndSelect Next Print(#CRLF$ + "Press ENTER to exit"): Input()
EndIf</lang>
Python
<lang python>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']</lang>
Here's a solution that is more in the spirit of the challenge, i.e. it never needs to generate the full set of expected permutations.
<lang python> def missing_permutation(arr):
"Find the missing permutation in an array of N! - 1 permutations." # We won't validate every precondition, but we do have some basic # guards. if len(arr) == 0: raise Exception("Need more data") if len(arr) == 1: return [arr[0][1] + arr[0][0]] # Now we know that for each position in the string, elements should appear # an even number of times (N-1 >= 2). We can use a set to detect the element appearing # an odd number of times. Detect odd occurrences by toggling admission/expulsion # to and from the set for each value encountered. At the end of each pass one element # will remain in the set. missing_permutation = for pos in range(len(arr[0])): s = set() for permutation in arr: c = permutation[pos] if c in s: s.remove(c) else: s.add(c) missing_permutation += list(s)[0] return missing_permutation
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()
print missing_permutation(given) </lang>
R
This uses the "combinat" package, which is a standard R package: <lang> 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) </lang>
Output: <lang> [1] "DBAC" </lang>
REXX
<lang rexx>/*REXX program finds a missing permuation from an internal list. */
list='ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA',
'CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB'
@.=; @abcU='ABCDEFGUIJKLMNOPQRSTUVWXYZ' things=4 bunch=4
do j=1 for things /*build list of permutation obj. */ $.j=substr(@abcu,j,1) end /*j*/
call permset 1 exit /*─────────────────────────────────────PERMSET subroutine───────────────*/ permset:procedure expose $. @. bunch list things; parse arg ? if ?>bunch then do; _=@.1; do m=2 to bunch
_=_||@.m end /*m*/ if wordpos(_,list)==0 then say _ ' is missing from the list.' end else do x=1 for things /*construction a new permuation. */ do k=1 for ?-1; if @.k==$.x then iterate x; end /*k*/ @.?=$.x call permset ?+1 end /*x*/
return</lang> output
DBAC is missing from the list.
Ruby
<lang ruby>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"]</lang>
Run BASIC
<lang runbasic>list$ = "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB"
for a = asc("A") to asc("D")
for b = asc("A") to asc("D") for c = asc("A") to asc("D") for d = asc("A") to asc("D") x$ = chr$(a) + chr$(b) + chr$(c)+ chr$(d) for i = 1 to 4 ' make sure each letter is unique j = instr(x$,mid$(x$,i,1)) if instr(x$,mid$(x$,i,1),j + 1) <> 0 then goto [nxt] next i if instr(list$,x$) = 0 then print x$;" missing" ' found missing permutation
[nxt] next d
next c next b
next a</lang>
DBAC missing
Scala
<lang scala>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))</lang>
Tcl
<lang tcl>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"</lang> Outputs
missing permutation(s): DBAC
I prefer to wrap the raw permutation generator up though: <lang tcl>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]</lang>
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.
<lang Ursala>permutations = ~&itB^?a\~&aNC *=ahPfatPRD refer ^C/~&a ~&ar&& ~&arh2falrtPXPRD</lang>
The ~&j
operator computes set differences.
<lang Ursala>#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]-</lang> output:
DBAC