Find the missing permutation

From Rosetta Code
Revision as of 14:29, 15 November 2015 by rosettacode>Smls (→‎{{header|Perl 6}}: no need for .tree anymore)
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.

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

There is another alternate method. Hint: if you add up the letter values of each column, does a missing letter A, B, C, D from each column cause the total value for each column to be unique? 

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

360 Assembly

Translation of: BBC BASIC

Very compact version, thanks to the clever Perl 6 "xor" algorithm. <lang 360asm>* Find the missing permutation - 19/10/2015 PERMMISX CSECT 

        USING  PERMMISX,R15       set base register
        LA     R4,0               i=0
        LA     R6,1               step
        LA     R7,23              to

LOOPI BXH R4,R6,ELOOPI do i=1 to hbound(perms) 

        LA     R5,0               j=0
        LA     R8,1               step
        LA     R9,4               to

LOOPJ BXH R5,R8,ELOOPJ do j=1 to hbound(miss) 

        LR     R1,R4              i
        SLA    R1,2               *4
        LA     R3,PERMS-5(R1)     @perms(i)
        AR     R3,R5              j
        LA     R2,MISS-1(R5)      @miss(j)
        XC     0(1,R2),0(R3)      miss(j)=miss(j) xor substr(perms(i),j,1)
        B      LOOPJ

ELOOPJ B LOOPI ELOOPI XPRNT MISS,15 print buffer 

        XR     R15,R15            set return code
        BR     R14                return to caller

PERMS DC C'ABCD',C'CABD',C'ACDB',C'DACB',C'BCDA',C'ACBD' 

        DC     C'ADCB',C'CDAB',C'DABC',C'BCAD',C'CADB',C'CDBA'
        DC     C'CBAD',C'ABDC',C'ADBC',C'BDCA',C'DCBA',C'BACD'
        DC     C'BADC',C'BDAC',C'CBDA',C'DBCA',C'DCAB'

MISS DC 4XL1'00',C' is missing' buffer 

        YREGS
        END    PERMMISX</lang>
Output:
DBAC is missing

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>

AWK

This reads the list of permutations as standard input and outputs the missing one.

<lang awk>{ 

 split($1,a,""); 
 for (i=1;i<=4;++i) { 
   t[i,a[i]]++; 
 }

} END { 

 for (k in t) {
   split(k,a,SUBSEP)
   for (l in t) {
     split(l, b, SUBSEP)
     if (a[1] == b[1] && t[k] < t[l]) {
       s[a[1]] = a[2]
       break
     }
   }
 }
 print s[1]s[2]s[3]s[4]

}</lang>

Output:

DBAC

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> DIM perms$(22), miss&(4) 

     perms$() = "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", \
     \  "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", \
     \  "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
     
     FOR i% = 0 TO DIM(perms$(),1)
       FOR j% = 1 TO DIM(miss&(),1)
         miss&(j%-1) EOR= ASCMID$(perms$(i%),j%)
       NEXT
     NEXT
     PRINT $$^miss&(0) " is missing"
     END</lang>
Output:
DBAC is missing

Burlesque

<lang burlesque> ln"ABCD"r@\/\\ </lang>

(Feed permutations via STDIN. Uses the naive method).

Version calculating frequency of occurences of each letter in each row and thus finding the missing permutation by choosing the letters with the lowest frequency:

<lang burlesque> ln)XXtp)><)F:)<]u[/v\[ </lang>

C

<lang C>#include <stdio.h>

  1. define N 4

const 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 occurrence */

for (i = 0; i < N; i++) { for (j = 0; j < N; j++) cnt[j] = 0;

/* count how many times each letter occur at position i */ for (j = 0; j < sizeof(perms)/sizeof(const char*); j++) cnt[perms[j][i] - 'A']++;

/* letter not occurring (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>

  1. include <vector>
  2. include <set>
  3. include <iterator>
  4. include <iostream>
  5. 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#

Works with: C# version 2+

<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.math.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> Here's a version based on the hint in the description. freqs is a sequence of letter frequency maps, one for each column. There should be 6 of each letter in each column, so we look for the one with 5. <lang clojure>(def abcds ["ABCD" "CABD" "ACDB" "DACB" "BCDA" "ACBD" "ADCB" "CDAB" 

           "DABC" "BCAD" "CADB" "CDBA" "CBAD" "ABDC" "ADBC" "BDCA" 
           "DCBA" "BACD" "BADC" "BDAC" "CBDA" "DBCA" "DCAB"])

(def freqs (->> abcds (apply map vector) (map frequencies)))

(defn v->k [fqmap v] (->> fqmap (filter #(-> % second (= v))) ffirst))

(->> freqs (map #(v->k % 5)) (apply str) println)</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:
 > coffee missing_permute.coffee 
DBAC

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>void main() { 

   import std.stdio, std.string, std.algorithm, std.range, std.conv;

   immutable 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: test all permutations.
   immutable permsSet = perms
                        .map!representation
                        .zip(true.repeat)
                        .assocArray;
   auto perm = perms[0].dup.representation;
   do {
       if (perm !in permsSet)
           writeln(perm.map!(c => char(c)));
   } while (perm.nextPermutation);

   // Version 2: xor all the ASCII values, the uneven one
   // gets flushed out. Based on Perl 6 (via Go).
   enum len = 4;
   char[len] b = 0;
   foreach (immutable p; perms)
       b[] ^= p[];
   b.writeln;

   // Version 3: sum ASCII values.
   immutable rowSum = perms[0].sum;
   len
   .iota
   .map!(i => to!char(rowSum - perms.transversal(i).sum % rowSum))
   .writeln;

   // Version 4: a checksum, Java translation. maxCode will be 36.
   immutable maxCode = reduce!q{a * b}(len - 1, iota(3, len + 1));

   foreach (immutable i; 0 .. len) {
       immutable code = perms.map!(p => perms[0].countUntil(p[i])).sum;

       // Code will come up 3, 1, 0, 2 short of 36.
       perms[0][maxCode - code].write;
   }

}</lang>

Output:
DBAC
DBAC
DBAC
DBAC

EchoLisp

<lang lisp>

use the obvious methos

(lib 'list) ; for (permutations) function

input

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

generate all permutations

(define all-perms (map list->string (permutations '(A B C D)))) 

  → all-perms
{set} substraction

(set-substract (make-set all-perms) (make-set perms)) 

 → { DBAC }

</lang>


Elixir

<lang elixir>defmodule RC do 

 def find_miss_perm(head, perms) do
   all_permutations(head) -- perms
 end
 
 defp all_permutations(string) do
   list = String.split(string, "", trim: true)
   Enum.map(permutations(list), fn x -> Enum.join(x) end)
 end
 
 defp permutations([]), do: [[]]
 defp permutations(list), do: (for x <- list, y <- permutations(list -- [x]), do: [x|y])

end

perms = ["ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", 

        "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"]

IO.inspect RC.find_miss_perm( hd(perms), perms )</lang>

Output:
["DBAC"]

Erlang

The obvious method. It seems fast enough (no waiting time). <lang Erlang> -module( find_missing_permutation ).

-export( [difference/2, task/0] ).

difference( Permutate_this, Existing_permutations ) -> all_permutations( Permutate_this ) -- Existing_permutations.

task() -> difference( "ABCD", existing_permutations() ).


all_permutations( String ) -> [[A, B, C, D] || A <- String, B <- String, C <- String, D <- String, is_different([A, B, C, D])].

existing_permutations() -> ["ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"].

is_different( [_H] ) -> true; is_different( [H | T] ) -> not lists:member(H, T) andalso is_different( T ). </lang>

Output:
6> find_the_missing_permutation:task().
["DBAC"]

ERRE

<lang ERRE> PROGRAM MISSING

CONST N=4

DIM PERMS$[23]

BEGIN 

 PRINT(CHR$(12);) ! CLS
 DATA("ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB")
 DATA("CDAB","DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC")
 DATA("BDCA","DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB")

 FOR I%=1 TO UBOUND(PERMS$,1) DO
   READ(PERMS$[I%])
 END FOR

 SOL$="...."

 FOR I%=1 TO N DO
   CH$=CHR$(I%+64)
   COUNT%=0
   FOR Z%=1 TO N DO
      COUNT%=0
      FOR J%=1 TO UBOUND(PERMS$,1) DO
         IF CH$=MID$(PERMS$[J%],Z%,1) THEN COUNT%=COUNT%+1 END IF
      END FOR
      IF COUNT%<>6 THEN
          !$RCODE="MID$(SOL$,Z%,1)=CH$"
      END IF
   END FOR
 END FOR
 PRINT("Solution is: ";SOL$)

END PROGRAM </lang>

Output:
Solution is: 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" ];
  1. convert L to permutations on 1..4

u := List(L, s -> List([1..4], i -> Position("ABCD", s[i])));

  1. set difference (with all permutations)

v := Difference(PermutationsList([1..4]), u);

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

Works with: GHC version 6.10+

<lang haskell>import Data.List import Control.Monad import Control.Arrow

missingPerm :: Eq a => a -> a missingPerm = (\\) =<< permutations . nub . join

deficientPermsList = ["ABCD","CABD","ACDB","DACB", 

                     "BCDA","ACBD","ADCB","CDAB",
                     "DABC","BCAD","CADB","CDBA",
                     "CBAD","ABDC","ADBC","BDCA",
                     "DCBA","BACD","BADC","BDAC",
                     "CBDA","DBCA","DCAB"]

main = do 

   print $ missingPerm deficientPermsList</lang>
Output:
["DBAC"]

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>

Library: Icon Programming Library

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>

Of course the task suggests that the missing permutation can be found without generating all permutations. And of course that is doable:

<lang J> 'ABCD'{~,I.@(= <./)@(#/.~)@('ABCD' , ])"1 |:perms DBAC</lang>

However, that's actually a false economy - not only does this approach take more code to implement (at least, in J) but we are already dealing with a data structure of approximately the size of all permutations. So what is being saved by this supposedly "more efficient" approach? Not much... (Still, perhaps this exercise is useful as an illustration of some kind of advertising concept?)

We could use parity, as suggested in the task hints: <lang J> ,(~.#~2|(#/.~))"1|:data DBAC</lang>

We could use arithmetic, as suggested in the task hints: <lang J> ({.data){~|(->./)+/({.i.])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>

jq

Works with: jq version 1.4

The following assumes that a file, Find_the_missing_permutation.txt, has the text exactly as presented in the task description.

To find the missing permutation, we can for simplicity invoke jq twice: 

 jq -R . Find_the_missing_permutation.txt | jq -s -f Find_the_missing_permutation.jq

The first invocation simply converts the raw text into a stream of JSON strings; these are then processed by the following program, which implements the parity-based approach.

The program will handle permutations of any set of uppercase letters. The letters need not be consecutive. Note that the following encoding of letters is used: A => 0, B => 1, ....

Infrastructure:

If your version of jq has transpose/0, the definition given here (which is the same as in Matrix_Transpose#jq) may be omitted. <lang jq>def transpose: 

 if (.[0] | length) == 0 then []
 else [map(.[0])] + (map(.[1:]) | transpose)
 end ;
  1. Input: an array of integers (based on the encoding of A=0, B=1, etc)
  2. corresponding to the occurrences in any one position of the
  3. letters in the list of permutations.
  4. Output: a tally in the form of an array recording in position i the
  5. parity of the number of occurrences of the letter corresponding to i.
  6. Example: given [0,1,0,1,2], the array of counts of 0, 1, and 2 is [2, 2, 1],
  7. and thus the final result is [0, 0, 1].

def parities: 

 reduce .[] as $x ( []; .[$x] = (1 + .[$x]) % 2);
  1. Input: an array of parity-counts, e.g. [0, 1, 0, 0]
  2. Output: the corresponding letter, e.g. "B".

def decode: 

 [index(1) + 65] | implode;
  1. encode a string (e.g. "ABCD") as an array (e.g. [0,1,2,3]):

def encode_string: [explode[] - 65];</lang>

The task: <lang jq>map(encode_string) | transpose | map(parities | decode) | join("")</lang>

Output:

<lang sh>$ jq -R . Find_the_missing_permutation.txt | jq -s -f Find_the_missing_permutation.jq "DBAC"</lang>

Julia

find_missing_permutations accepts a list of strings and finds any permutations of the first string in the list that are missing from the list. If the list contains any strings that are not such permutations (including the first item), the function throws a DomainError. Duplicated permutations are silently ignored.

I chose to solve this task by permutation enumeration because Julia provides good native functions for creating and processing list permutations. Also, this function detects multiple missing permutations and tolerates duplicated items in the input list. The function will fail if the length of the strings exceeds 20. This failure occurs because the number of possible permutations then exceeds typemax(Int64). But good luck with this sort of task when the strings approach such lengths.

Function <lang Julia> function find_missing_permutations{T<:String}(a::Array{T,1}) 

   std = unique(sort(split(a[1], "")))
   needsperm = trues(factorial(length(std)))
   for s in a
       b = split(s, "")
       p = map(x->findfirst(std, x), b)
       isperm(p) || throw(DomainError())
       needsperm[nthperm(p)] = false
   end
   mperms = T[]
   for i in findn(needsperm)[1]
       push!(mperms, join(nthperm(std, i), ""))
   end
   return mperms

end </lang>

Main <lang Julia> test = ["ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", 

       "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA",
       "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD",
       "BADC", "BDAC", "CBDA", "DBCA", "DCAB"]

missperms = find_missing_permutations(test)

print("The test list is:\n ") i = 0 for s in test 

   print(s, " ")
   i += 1
   i %= 5
   i != 0 || print("\n    ")

end i == 0 || println() if length(missperms) > 0 

   println("The following permutations are missing:")
   for s in missperms
       println("    ", s)
   end

else 

   println("There are no missing permutations.")

end </lang>

Output:
The test list is:
    ABCD CABD ACDB DACB BCDA 
    ACBD ADCB CDAB DABC BCAD 
    CADB CDBA CBAD ABDC ADBC 
    BDCA DCBA BACD BADC BDAC 
    CBDA DBCA DCAB 
The following permutations are missing:
    DBAC

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 / Wolfram Language

<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"};

Complement[StringJoin /@ Permutations@Characters@First@#, #] &@ProvidedSet


->{"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>

Nim

Translation of: Python

<lang nim>import strutils

proc missingPermutation(arr): string = 

 result = ""
 if arr.len == 0: return
 if arr.len == 1: return arr[0][1] & arr[0][0]

 for pos in 0 .. <arr[0].len:
   var s: set[char] = {}
   for permutation in arr:
     let c = permutation[pos]
     if c in s: s.excl c
     else:      s.incl c
   for c in s: result.add c

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

echo missingPermutation(given)</lang>

Output:
DBAC

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>

Octave

<lang octave>given = [ 'ABCD';'CABD';'ACDB';'DACB'; ... 

         'BCDA';'ACBD';'ADCB';'CDAB'; ...
         'DABC';'BCAD';'CADB';'CDBA'; ...
         'CBAD';'ABDC';'ADBC';'BDCA'; ...
         'DCBA';'BACD';'BADC';'BDAC'; ...
         'CBDA';'DBCA';'DCAB' ];

val = 4.^(3:-1:0)'; there = 1+(toascii(given)-toascii('A'))*val; every = 1+perms(0:3)*val;

bits = zeros(max(every),1); bits(every) = 1; bits(there) = 0; missing = dec2base(find(bits)-1,'ABCD') </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>

PARI/GP

<lang parigp>v=["ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB","DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA","DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB"]; v=apply(u->permtonum(apply(n->n-64,Vec(Vecsmall(u)))),v); t=numtoperm(4, binomial(4!,2)-sum(i=1,#v,v[i])); Strchr(apply(n->n+64,t))</lang>

Output:
%1 = "DBAC"

Pascal

like c, summation, and Perl 6 XORing <lang pascal>program MissPerm; {$MODE DELPHI} //for result

const 

 maxcol = 4;

type 

 tmissPerm = 1..23;
 tcol = 1..maxcol;
 tResString = String[maxcol];

const 

 Given_Permutations : array [tmissPerm] of tResString =
    ('ABCD', 'CABD', 'ACDB', 'DACB', 'BCDA', 'ACBD',
     'ADCB', 'CDAB', 'DABC', 'BCAD', 'CADB', 'CDBA',
     'CBAD', 'ABDC', 'ADBC', 'BDCA', 'DCBA', 'BACD',
     'BADC', 'BDAC', 'CBDA', 'DBCA', 'DCAB');
 chOfs =  Ord('A')-1;

var 

 SumElemCol: array[tcol,tcol] of NativeInt;

function fib(n: NativeUint): NativeUint; var 

 i : NativeUint;

Begin 

 result := 1;
 For i := 2 to n do
   result:= result*i;

end;

function CountOccurences: tresString; //count the number of every letter in every column //should be (colmax-1)! => 6 //the missing should count (colmax-1)! -1 => 5 var 

 fibN_1 : NativeUint;
 row, col: NativeInt;

Begin 

 For row := low(tmissPerm) to High(tmissPerm) do
   For col := low(tcol) to High(tcol) do
     inc(SumElemCol[col,ORD(Given_Permutations[row,col])-chOfs]);

 //search the missing
 fibN_1 := fib(maxcol-1)-1;
 setlength(result,maxcol);
 For col := low(tcol) to High(tcol) do
   For row := low(tcol) to High(tcol) do
     IF SumElemCol[col,row]=fibN_1 then
       result[col]:= chr(row+chOfs);

end;

function CheckXOR: tresString; var 

 row,col: NativeUint;

Begin 

 setlength(result,maxcol);
 fillchar(result[1],maxcol,#0);
 For row := low(tmissPerm) to High(tmissPerm) do
   For col := low(tcol) to High(tcol) do
     result[col] := chr(ord(result[col]) XOR ord(Given_Permutations[row,col]));

end;

Begin 

 writeln(CountOccurences,' is missing');
 writeln(CheckXOR,' is missing');

end.</lang>

Output:
DBAC is missing
DBAC is missing

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); }

}

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

<lang perl6>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>;

my @perms = <A B C D>.permutations.map: *.join;

.say when none(@givens) for @perms;</lang>

Output:
DBAC

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;</lang>

Output:
DBAC

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

PowerShell

Works with: PowerShell version 4.0

<lang PowerShell> function permutation ($array) { 

   function generate($n, $array, $A) {
       if($n -eq 1) {
           $array[$A] -join 
       }
       else{
           for( $i = 0; $i -lt ($n - 1); $i += 1) {
               generate ($n - 1) $array $A
               if($n % 2 -eq 0){
                   $i1, $i2 = $i, ($n-1)
                   $temp = $A[$i1]
                   $A[$i1] = $A[$i2]
                   $A[$i2] = $temp
               }
               else{
                   $i1, $i2 = 0, ($n-1)
                   $temp = $A[$i1]
                   $A[$i1] = $A[$i2]
                   $A[$i2] = $temp
               }
           }
           generate ($n - 1) $array $A
       }
   }
   $n = $array.Count
   if($n -gt 0) {
       (generate $n $array (0..($n-1)))
   } else {$array}

} $perm = permutation @('A','B','C', 'D') $find = @( "ABCD" "CABD" "ACDB" "DACB" "BCDA" "ACBD" "ADCB" "CDAB" "DABC" "BCAD" "CADB" "CDBA" "CBAD" "ABDC" "ADBC" "BDCA" "DCBA" "BACD" "BADC" "BDAC" "CBDA" "DBCA" "DCAB" ) $perm | where{-not $find.Contains($_)} </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

Python: Calculate difference when compared to all permutations

Works with: Python version 2.6+

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

Python:Counting lowest frequency character at each position

Here is 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>

Python:Counting lowest frequency character at each position: functional

Uses the same method as explained directly above, but calculated in a more functional manner: <lang python>>>> from collections import Counter >>> 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()

>>> .join(Counter(x).most_common()[-1][0] for x in zip(*given)) 'DBAC' >>> </lang>

Explanation

It is rather obfuscated, but can be explained by showing these intermediate results and noting that zip(*x) transposes x; and that at the end of the list created by the call to most_common() is the least common character. <lang python>>>> from pprint import pprint as pp >>> pp(list(zip(*given)), width=120) [('A', 'C', 'A', 'D', 'B', 'A', 'A', 'C', 'D', 'B', 'C', 'C', 'C', 'A', 'A', 'B', 'D', 'B', 'B', 'B', 'C', 'D', 'D'), 

('B', 'A', 'C', 'A', 'C', 'C', 'D', 'D', 'A', 'C', 'A', 'D', 'B', 'B', 'D', 'D', 'C', 'A', 'A', 'D', 'B', 'B', 'C'),
('C', 'B', 'D', 'C', 'D', 'B', 'C', 'A', 'B', 'A', 'D', 'B', 'A', 'D', 'B', 'C', 'B', 'C', 'D', 'A', 'D', 'C', 'A'),
('D', 'D', 'B', 'B', 'A', 'D', 'B', 'B', 'C', 'D', 'B', 'A', 'D', 'C', 'C', 'A', 'A', 'D', 'C', 'C', 'A', 'A', 'B')]

>>> pp([Counter(x).most_common() for x in zip(*given)]) [[('C', 6), ('B', 6), ('A', 6), ('D', 5)], 

[('D', 6), ('C', 6), ('A', 6), ('B', 5)],
[('D', 6), ('C', 6), ('B', 6), ('A', 5)],
[('D', 6), ('B', 6), ('A', 6), ('C', 5)]]

>>> pp([Counter(x).most_common()[-1] for x in zip(*given)]) [('D', 5), ('B', 5), ('A', 5), ('C', 5)] >>> pp([Counter(x).most_common()[-1][0] for x in zip(*given)]) ['D', 'B', 'A', 'C'] >>> .join([Counter(x).most_common()[-1][0] for x in zip(*given)]) 'DBAC' >>> </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:
[1] "DBAC"

Racket

<lang racket>

  1. lang racket

(define almost-all 

 '([A B C D] [C A B D] [A C D B] [D A C B] [B C D A] [A C B D] [A D C B]
   [C D A B] [D A B C] [B C A D] [C A D B] [C D B A] [C B A D] [A B D C]
   [A D B C] [B D C A] [D C B A] [B A C D] [B A D C] [B D A C] [C B D A]
   [D B C A] [D C A B]))


Obvious method

(for/first ([p (in-permutations (car almost-all))] 

           #:unless (member p almost-all))
 p)
-> '(D B A C)


For permutations of any set

(define charmap 

 (for/hash ([x (in-list (car almost-all))] [i (in-naturals)])
   (values x i)))

(define size (hash-count charmap))

Illustrating approach mentioned in the task description.
For each position, character with odd parity at that position.

(require data/bit-vector)

(for/list ([i (in-range size)]) 

 (define parities (make-bit-vector size #f))
 (for ([permutation (in-list almost-all)])
   (define n (hash-ref charmap (list-ref permutation i)))
   (bit-vector-set! parities n (not (bit-vector-ref parities n))))
 (for/first ([(c i) charmap] #:when (bit-vector-ref parities i))
   c))
-> '(D B A C)

</lang>

RapidQ

<lang vb> Dim PList as QStringList PList.addItems "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB" PList.additems "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA" PList.additems "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"

Dim NumChar(4, 65 to 68) as integer Dim MPerm as string

'Create table with occurences For x = 0 to PList.Itemcount -1 

   for y = 1 to 4
       Inc(NumChar(y, asc(PList.Item(x)[y])))
   next

next

'When a char only occurs 5 times it's the missing one for x = 1 to 4 

   for y = 65 to 68
       MPerm = MPerm + iif(NumChar(x, y)=5, chr$(y), "")
   next

next

showmessage MPerm '= DBAC </lang>

REXX

<lang rexx>/*REXX program finds one or more missing permutations 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'

@.= /* [↓] needs to be as long as THINGS.*/ @abcU = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*an uppercase (Latin/Roman) alphabet. */ things = 4 /*number of unique letters to be used. */ bunch = 4 /*number letters to be used at a time. */ 

                do j=1  for things    /* [↓]  only get a portion of alphabet.*/
                $.j=substr(@abcU,j,1) /*extract just one letter from alphabet*/
                end   /*j*/           /* [↑]  build a letter array for speed.*/

call permSet 1 /*invoke PERMSET sub. (recursively). */ exit /*stick a fork in it, we're all done. */ /*────────────────────────────────────────────────────────────────────────────*/ permSet: procedure expose $. @. bunch list things; parse arg ? if ?>bunch then do 

                _=;      do m=1  for bunch           /*build a permutation.  */
                         _=_ || @.m                  /*add permutation──►list*/
                         end   /*m*/
                                                     /* [↓]  is in the list? */
                if wordpos(_,list)==0  then say _  ' is missing from the list.'
                end
           else do x=1  for things                   /*build a permutation.  */
                         do k=1  for ?-1
                         if @.k==$.x then iterate x  /*was permutation built?*/
                         end  /*k*/
                @.?=$.x                              /*define as being built.*/
                call permSet  ?+1                    /*call subr. recursively*/
                end   /*x*/

return</lang>

Output:
DBAC  is missing from the list.

Ruby

Works with: Ruby version 2.0+

<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].chars.permutation.collect(&:join)

puts "missing: #{all - given}"</lang>

Output:
missing: ["DBAC"]

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>

Output:
DBAC missing

Scala

Library: Scala
Works with: Scala version 2.8

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

Scala 2.9.x

Works with: Scala version 2.9.1

<lang Scala>println("missing perms: "+("ABCD".permutations.toSet 

 --"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(" ").toSet))</lang>

Seed7

<lang seed7>$ include "seed7_05.s7i";

const func string: missingPermutation (in array string: perms) is func 

 result
   var string: missing is "";
 local
   var integer: pos is 0;
   var set of char: chSet is (set of char).EMPTY_SET;
   var string: permutation is "";
   var char: ch is ' ';
 begin
   if length(perms) <> 0 then
     for key pos range perms[1] do
       chSet := (set of char).EMPTY_SET;
       for permutation range perms do
         ch := permutation[pos];
         if ch in chSet then
           excl(chSet, ch);
         else
           incl(chSet, ch);
         end if;
       end for;
       missing &:= min(chSet);
     end for;
   end if;
 end func;

const proc: main is func 

 begin
   writeln(missingPermutation([] ("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD",
          "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC",
          "BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB")));
 end func;</lang>
Output:
DBAC

Sidef

Translation of: Perl

<lang ruby>func check_perm(arr) { 

   (var hash = Hash.new).@{arr} = @[1]*arr.len;
   arr.each { |s|
       s.len.times {
           var t = (s.substr(1) + s.substr(0, 1));
           hash.has_key(t) || return t;
       }
   }

}

var perms = %w(ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA 

              CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB);

say check_perm(perms);</lang>

Output:
DBAC

Tcl

Library: Tcllib (Package: struct::list)

<lang tcl> package require struct::list

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 \

}

struct::list foreachperm element {A B C D} { set text [join $element ""] if {$text ni $have} { puts "Missing permutation(s): $text" } } </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

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

VBScript

Uses the 3rd method approach by adding the columns. <lang vb> arrp = Array("ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD",_ 

     "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA",_
     "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD",_
     "BADC", "BDAC", "CBDA", "DBCA", "DCAB")

Dim col(4)

'supposes that a complete column have 6 of each letter. target = (6*Asc("A")) + (6*Asc("B")) + (6*Asc("C")) + (6*Asc("D"))

missing = ""

For i = 0 To UBound(arrp) For j = 1 To 4 

           col(j) = col(j) + Asc(Mid(arrp(i),j,1))

Next Next

For k = 1 To 4 n = target - col(k) missing = missing & Chr(n) Next

WScript.StdOut.WriteLine missing </lang>

Output:
DBAC

XPL0

The list of permutations is input by using a command line like this: missperm <missperm.txt

<lang XPL0>code HexIn=26, HexOut=27; int P, I; [P:= 0; for I:= 1 to 24-1 do P:= P xor HexIn(1); HexOut(0, P); ]</lang>

Output:
0000DBAC

zkl

Since I just did the "generate the permutations" task, I'm going to use it to do the brute force solution. <lang zkl>var data=L("ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB", 

          "DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA",
          "DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB");

Utils.Helpers.permute(["A".."D"]).apply("concat").copy().remove(data.xplode());</lang> Copy creates a read/write list from a read only list. xplode() pushes all elements of data as parameters to remove.

Output:
L("DBAC")
Retrieved from "https://rosettacode.org/wiki/Find_the_missing_permutation?oldid=135178"