aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/Find-the-missing-permutation/00DESCRIPTION
View file

@ -12,6 +12,10 @@ 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?
<pre>ABCD
CABD
ACDB

29
Task/Find-the-missing-permutation/360-Assembly/find-the-missing-permutation.360 Normal file
View file

@ -0,0 +1,29 @@
* 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

19
Task/Find-the-missing-permutation/AWK/find-the-missing-permutation.awk Normal file
View file

@ -0,0 +1,19 @@
{
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]
}

18
Task/Find-the-missing-permutation/Elixir/find-the-missing-permutation.elixir Normal file
View file

@ -0,0 +1,18 @@
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 )

2
Task/Find-the-missing-permutation/J/find-the-missing-permutation-7.j Normal file
View file

@ -0,0 +1,2 @@
,(~.#~2|(#/.~))"1|:data
DBAC

2
Task/Find-the-missing-permutation/J/find-the-missing-permutation-8.j Normal file
View file

@ -0,0 +1,2 @@
({.data){~|(->./)+/({.i.])data
DBAC

0
Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation.js → Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-1.js
View file

40
Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-2.js Normal file
View file

@ -0,0 +1,40 @@
(function (strList) {
// [a] -> [[a]]
function permutations(xs) {
return xs.length ? (
chain(xs, function (x) {
return chain(permutations(deleted(x, xs)), function (ys) {
return [[x].concat(ys).join('')];
})
})) : [[]];
}
// Monadic bind/chain for lists
// [a] -> (a -> b) -> [b]
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
// a -> [a] -> [a]
function deleted(x, xs) {
return xs.length ? (
x === xs[0] ? xs.slice(1) : [xs[0]].concat(
deleted(x, xs.slice(1))
)
) : [];
}
// Provided subset
var lstSubSet = strList.split('\n');
// Any missing permutations
// (we can use fold/reduce, filter, or chain (concat map) here)
return chain(permutations('ABCD'.split('')), function (x) {
return lstSubSet.indexOf(x) === -1 ? [x] : [];
});
})(
'ABCD\nCABD\nACDB\nDACB\nBCDA\nACBD\nADCB\nCDAB\nDABC\nBCAD\nCADB\n\
CDBA\nCBAD\nABDC\nADBC\nBDCA\nDCBA\nBACD\nBADC\nBDAC\nCBDA\nDBCA\nDCAB'
);

1
Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-3.js Normal file
View file

@ -0,0 +1 @@
["DBAC"]

15
Task/Find-the-missing-permutation/Julia/find-the-missing-permutation-1.julia Normal file
View file

@ -0,0 +1,15 @@
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

24
Task/Find-the-missing-permutation/Julia/find-the-missing-permutation-2.julia Normal file
View file

@ -0,0 +1,24 @@
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

63
Task/Find-the-missing-permutation/Pascal/find-the-missing-permutation.pascal Normal file
View file

@ -0,0 +1,63 @@
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.

2
Task/Find-the-missing-permutation/Perl-6/find-the-missing-permutation-1.pl6
View file

@ -1,6 +1,6 @@
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.tree.map: *.join;
my @perms = <A B C D>.permutations.map: *.join;
.say when none(@givens) for @perms;

56
Task/Find-the-missing-permutation/PowerShell/find-the-missing-permutation.psh Normal file
View file

@ -0,0 +1,56 @@
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($_)}

51
Task/Find-the-missing-permutation/REXX/find-the-missing-permutation.rexx
View file

@ -1,30 +1,29 @@
/*REXX program finds (a) missing permutation(s) 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 THINGS long. */
@abcU = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*an uppercase (Latin) alphabet. */
things = 4 /*# of unique letters to be used.*/
bunch = 4 /*# letters to be used at a time.*/
do j=1 for things
$.j=substr(@abcU,j,1)
end /*j*/ /* [↑] construct a letter array.*/
call permset 1 /*invoke PERMSET (recursively).*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────PERMSET subroutine──────────────────*/
permset: procedure expose $. @. bunch list things; parse arg ?
/*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 permutation*/
_=_ || @.m /*add perm ──► list*/
end /*m*/
/* [↓] is in list?*/
if wordpos(_,list)==0 then say _ ' is missing from the list.'
_=; 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 new perm.*/
do k=1 for ?-1
if @.k==$.x then iterate x /*been built?*/
end /*k*/
@.?=$.x /*define as built. */
call permset ?+1 /*call recursively.*/
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

13
Task/Find-the-missing-permutation/Tcl/find-the-missing-permutation.tcl Normal file
View file

@ -0,0 +1,13 @@
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"
}
}

24
Task/Find-the-missing-permutation/VBScript/find-the-missing-permutation.vb Normal file
View file

@ -0,0 +1,24 @@
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