September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,36 @@
|
|||
void
|
||||
paste(record r, index x, data p, integer a,)
|
||||
{
|
||||
i_delete(x, a);
|
||||
p[i_size(x)] = a;
|
||||
if (i_size(x)) {
|
||||
i_wcall(x, paste, -1, -1, r, x, p);
|
||||
} else {
|
||||
r[b_string(p)] = 0;
|
||||
}
|
||||
x[a] = 0;
|
||||
}
|
||||
|
||||
integer
|
||||
main(void)
|
||||
{
|
||||
record r;
|
||||
list l;
|
||||
index x;
|
||||
data p;
|
||||
|
||||
l_bill(l, 0, "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB",
|
||||
"CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC",
|
||||
"BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB");
|
||||
|
||||
i_fit(x, 'A', 0, 'B', 0, 'C', 0, 'D', 0);
|
||||
|
||||
b_size(p, 4);
|
||||
i_wcall(x, paste, -1, -1, r, x, p);
|
||||
|
||||
l_ucall(l, r_delete, 1, r);
|
||||
|
||||
o_(r_low(r), "\n");
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -1,85 +1,39 @@
|
|||
use framework "Foundation"
|
||||
use framework "Foundation" -- ( sort )
|
||||
|
||||
-- UNDER-REPRESENTED CHARACTER IN EACH OF N COLUMNS
|
||||
|
||||
-- missingChar :: Record -> Character
|
||||
script missingChar
|
||||
-- mean :: [Num] -> Num
|
||||
on mean(xs)
|
||||
script sum
|
||||
on lambda(a, b)
|
||||
a + b
|
||||
end lambda
|
||||
end script
|
||||
|
||||
foldl(sum, 0, xs) / (length of xs)
|
||||
end mean
|
||||
|
||||
-- Record -> Character
|
||||
on lambda(rec)
|
||||
set nMean to mean(allValues(rec))
|
||||
|
||||
script belowMean
|
||||
on lambda(a, x, i)
|
||||
set k to toLowerCase(x)
|
||||
if a is missing value then
|
||||
set v to keyValue(rec, k)
|
||||
if v < nMean then
|
||||
toUpperCase(x)
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
else
|
||||
a
|
||||
end if
|
||||
end lambda
|
||||
end script
|
||||
|
||||
foldl(belowMean, missing value, allKeys(rec))
|
||||
end lambda
|
||||
end script
|
||||
|
||||
-- Count of each character type in each character column
|
||||
|
||||
-- colCounts :: [Character] -> Record
|
||||
script colCounts
|
||||
on lambda(xs)
|
||||
script tally
|
||||
on lambda(a, x)
|
||||
set k to toLowerCase(x)
|
||||
set v to keyValue(a, k)
|
||||
if v is missing value then
|
||||
set n to 1
|
||||
else
|
||||
set n to v + 1
|
||||
end if
|
||||
updatedRecord(a, k, n)
|
||||
end lambda
|
||||
end script
|
||||
|
||||
foldl(tally, {name:""}, xs)
|
||||
end lambda
|
||||
end script
|
||||
|
||||
-- TEST
|
||||
-- RAREST LETTER IN EACH COLUMN -----------------------------------------------
|
||||
on run
|
||||
|
||||
map(missingChar, ¬
|
||||
map(colCounts, ¬
|
||||
transpose(map(curry(splitOn)'s lambda(""), ¬
|
||||
splitOn(space, ¬
|
||||
"ABCD CABD ACDB DACB BCDA ACBD " & ¬
|
||||
"ADCB CDAB DABC BCAD CADB CDBA " & ¬
|
||||
"CBAD ABDC ADBC BDCA DCBA BACD " & ¬
|
||||
"BADC BDAC CBDA DBCA DCAB"))))) as text
|
||||
intercalate("", ¬
|
||||
map(compose({¬
|
||||
sort, ¬
|
||||
group, ¬
|
||||
curry(minimumBy)'s lambda(comparing(_length)), ¬
|
||||
head}), ¬
|
||||
transpose(map(stringChars, (splitOn(space, ¬
|
||||
"ABCD CABD ACDB DACB BCDA ACBD " & ¬
|
||||
"ADCB CDAB DABC BCAD CADB CDBA " & ¬
|
||||
"CBAD ABDC ADBC BDCA DCBA BACD " & ¬
|
||||
"BADC BDAC CBDA DBCA DCAB"))))))
|
||||
|
||||
--> "DBAC"
|
||||
end run
|
||||
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
-- GENERIC FUNCTIONS ----------------------------------------------------------
|
||||
|
||||
-- GENERIC FUNCTIONS
|
||||
-- compose :: [(a -> a)] -> (a -> a)
|
||||
on compose(fs)
|
||||
script
|
||||
on lambda(x)
|
||||
script
|
||||
on lambda(a, f)
|
||||
mReturn(f)'s lambda(a)
|
||||
end lambda
|
||||
end script
|
||||
|
||||
foldl(result, x, fs)
|
||||
end lambda
|
||||
end script
|
||||
end compose
|
||||
|
||||
-- transpose :: [[a]] -> [[a]]
|
||||
on transpose(xss)
|
||||
|
|
@ -98,6 +52,61 @@ on transpose(xss)
|
|||
map(column, item 1 of xss)
|
||||
end transpose
|
||||
|
||||
-- sort :: [a] -> [a]
|
||||
on sort(lst)
|
||||
((current application's NSArray's arrayWithArray:lst)'s ¬
|
||||
sortedArrayUsingSelector:"compare:") as list
|
||||
end sort
|
||||
|
||||
-- group :: Eq a => [a] -> [[a]]
|
||||
on group(xs)
|
||||
script eq
|
||||
on lambda(a, b)
|
||||
a = b
|
||||
end lambda
|
||||
end script
|
||||
|
||||
groupBy(eq, xs)
|
||||
end group
|
||||
|
||||
-- minimumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
on minimumBy(f, xs)
|
||||
set mf to mReturn(f)
|
||||
script min
|
||||
on lambda(a, b)
|
||||
if a is missing value then
|
||||
b
|
||||
else if mf's lambda(a, b) < 0 then
|
||||
a
|
||||
else
|
||||
b
|
||||
end if
|
||||
end lambda
|
||||
end script
|
||||
|
||||
foldl(min, missing value, xs)
|
||||
end minimumBy
|
||||
|
||||
-- comparing :: (a -> b) -> (a -> a -> Ordering)
|
||||
on comparing(f)
|
||||
set mf to mReturn(f)
|
||||
script
|
||||
on lambda(a, b)
|
||||
set x to mf's lambda(a)
|
||||
set y to mf's lambda(b)
|
||||
if x < y then
|
||||
-1
|
||||
else
|
||||
if x > y then
|
||||
1
|
||||
else
|
||||
0
|
||||
end if
|
||||
end if
|
||||
end lambda
|
||||
end script
|
||||
end comparing
|
||||
|
||||
-- curry :: (Script|Handler) -> Script
|
||||
on curry(f)
|
||||
script
|
||||
|
|
@ -111,6 +120,82 @@ on curry(f)
|
|||
end script
|
||||
end curry
|
||||
|
||||
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||
on groupBy(f, xs)
|
||||
set mf to mReturn(f)
|
||||
|
||||
script enGroup
|
||||
on lambda(a, x)
|
||||
if length of (active of a) > 0 then
|
||||
set h to item 1 of active of a
|
||||
else
|
||||
set h to missing value
|
||||
end if
|
||||
|
||||
if h is not missing value and mf's lambda(h, x) then
|
||||
{active:(active of a) & x, sofar:sofar of a}
|
||||
else
|
||||
{active:{x}, sofar:(sofar of a) & {active of a}}
|
||||
end if
|
||||
end lambda
|
||||
end script
|
||||
|
||||
if length of xs > 0 then
|
||||
set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, tail(xs))
|
||||
if length of (active of dct) > 0 then
|
||||
sofar of dct & {active of dct}
|
||||
else
|
||||
sofar of dct
|
||||
end if
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end groupBy
|
||||
|
||||
-- head :: [a] -> a
|
||||
on head(xs)
|
||||
if length of xs > 0 then
|
||||
item 1 of xs
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end head
|
||||
|
||||
-- tail :: [a] -> [a]
|
||||
on tail(xs)
|
||||
if length of xs > 1 then
|
||||
items 2 thru -1 of xs
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end tail
|
||||
|
||||
-- splitOn :: Text -> Text -> [Text]
|
||||
on splitOn(strDelim, strMain)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
|
||||
set xs to text items of strMain
|
||||
set my text item delimiters to dlm
|
||||
return xs
|
||||
end splitOn
|
||||
|
||||
-- stringChars :: String -> [Char]
|
||||
on stringChars(s)
|
||||
characters of s
|
||||
end stringChars
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on _length(xs)
|
||||
length of xs
|
||||
end _length
|
||||
|
||||
-- intercalate :: Text -> [Text] -> Text
|
||||
on intercalate(strText, lstText)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strText}
|
||||
set strJoined to lstText as text
|
||||
set my text item delimiters to dlm
|
||||
return strJoined
|
||||
end intercalate
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, xs)
|
||||
tell mReturn(f)
|
||||
|
|
@ -135,19 +220,6 @@ on foldl(f, startValue, xs)
|
|||
end tell
|
||||
end foldl
|
||||
|
||||
-- splitOn :: Text -> Text -> [Text]
|
||||
on splitOn(strDelim, strMain)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
|
||||
set xs to text items of strMain
|
||||
set my text item delimiters to dlm
|
||||
return xs
|
||||
end splitOn
|
||||
|
||||
-- ord :: Character -> Int
|
||||
on ord(x)
|
||||
id of x
|
||||
end ord
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
|
|
@ -159,52 +231,3 @@ on mReturn(f)
|
|||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
|
||||
-- NSString
|
||||
|
||||
-- toLowerCase :: String -> String
|
||||
on toLowerCase(str)
|
||||
set ca to current application
|
||||
((ca's NSString's stringWithString:(str))'s ¬
|
||||
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
|
||||
end toLowerCase
|
||||
|
||||
-- toUpperCase :: String -> String
|
||||
on toUpperCase(str)
|
||||
set ca to current application
|
||||
((ca's NSString's stringWithString:(str))'s ¬
|
||||
uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
|
||||
end toUpperCase
|
||||
|
||||
|
||||
-- NSDictionary
|
||||
|
||||
-- allKeys :: Record -> [String]
|
||||
on allKeys(rec)
|
||||
(current application's NSDictionary's dictionaryWithDictionary:rec)'s allKeys() as list
|
||||
end allKeys
|
||||
|
||||
-- allValues :: Record -> [a]
|
||||
on allValues(rec)
|
||||
(current application's NSDictionary's dictionaryWithDictionary:rec)'s allValues() as list
|
||||
end allValues
|
||||
|
||||
-- keyValue :: Record -> String -> Maybe String
|
||||
on keyValue(rec, strKey)
|
||||
set ca to current application
|
||||
set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey
|
||||
if v is not missing value then
|
||||
item 1 of ((ca's NSArray's arrayWithObject:v) as list)
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end keyValue
|
||||
|
||||
-- updatedRecord :: Record -> String -> a -> Record
|
||||
on updatedRecord(rec, strKey, varValue)
|
||||
set ca to current application
|
||||
set nsDct to (ca's NSMutableDictionary's dictionaryWithDictionary:rec)
|
||||
nsDct's setValue:varValue forKey:strKey
|
||||
item 1 of ((ca's NSArray's arrayWithObject:nsDct) as list)
|
||||
end updatedRecord
|
||||
|
|
|
|||
|
|
@ -1,35 +0,0 @@
|
|||
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)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
> coffee missing_permute.coffee
|
||||
DBAC
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
import std.stdio, std.string, std.algorithm, std.array, std.range;
|
||||
|
||||
void main() {
|
||||
const givenSet = "ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC
|
||||
BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA
|
||||
DBCA DCAB"d.split().zip(repeat(true)).assocArray();
|
||||
|
||||
auto p = "ABCD"d.dup;
|
||||
do {
|
||||
if (p !in givenSet)
|
||||
writeln("Missing permutation: ", p);
|
||||
} while (p.nextPermutation());
|
||||
}
|
||||
|
|
@ -1,40 +0,0 @@
|
|||
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]);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
hex
|
||||
ABCD CABD xor ACDB xor DACB xor BCDA xor ACBD xor
|
||||
ADCB xor CDAB xor DABC xor BCAD xor CADB xor CDBA xor
|
||||
CBAD xor ABDC xor ADBC xor BDCA xor DCBA xor BACD xor
|
||||
BADC xor BDAC xor CBDA xor DBCA xor DCAB xor
|
||||
cr .( Missing permutation: ) u.
|
||||
decimal
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
' version 30-03-2017
|
||||
' compile with: fbc -s console
|
||||
|
||||
Data "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD"
|
||||
Data "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA"
|
||||
Data "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD"
|
||||
Data "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ulong total(3, Asc("A") To Asc("D")) ' total(0 to 3, 65 to 68)
|
||||
Dim As ULong i, j, n = 24 \ 4 ' n! \ n
|
||||
Dim As String tmp
|
||||
|
||||
For i = 1 To 23
|
||||
Read tmp
|
||||
For j = 0 To 3
|
||||
total(j, tmp[j]) += 1
|
||||
Next
|
||||
Next
|
||||
|
||||
tmp = Space(4)
|
||||
For i = 0 To 3
|
||||
For j = Asc("A") To Asc("D")
|
||||
If total(i, j) <> n Then
|
||||
tmp[i] = j
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
|
||||
Print "The missing permutation is : "; tmp
|
||||
|
||||
' empty keyboard buffer
|
||||
While InKey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
' version 30-03-2017
|
||||
' compile with: fbc -s console
|
||||
|
||||
Data "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD"
|
||||
Data "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA"
|
||||
Data "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD"
|
||||
Data "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ULong total(3) ' total(0 to 3)
|
||||
Dim As ULong i, j, n = 24 \ 4 ' n! \ n
|
||||
Dim As ULong total_val = (Asc("A") + Asc("B") + Asc("C") + Asc("D")) * n
|
||||
Dim As String tmp
|
||||
|
||||
For i = 1 To 23
|
||||
Read tmp
|
||||
For j = 0 To 3
|
||||
total(j) += tmp[j]
|
||||
Next
|
||||
Next
|
||||
|
||||
tmp = Space(4)
|
||||
For i = 0 To 3
|
||||
tmp[i] = total_val - total(i)
|
||||
Next
|
||||
|
||||
Print "The missing permutation is : "; tmp
|
||||
|
||||
' empty keyboard buffer
|
||||
While Inkey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
' version 30-03-2017
|
||||
' compile with: fbc -s console
|
||||
|
||||
Data "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD"
|
||||
Data "ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA"
|
||||
Data "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD"
|
||||
Data "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ULong i,j
|
||||
Dim As String tmp, missing = chr(0, 0, 0, 0) ' or string(4, 0)
|
||||
|
||||
For i = 1 To 23
|
||||
Read tmp
|
||||
For j = 0 To 3
|
||||
missing[j] Xor= tmp[j]
|
||||
Next
|
||||
Next
|
||||
|
||||
Print "The missing permutation is : "; missing
|
||||
|
||||
' empty keyboard buffer
|
||||
While Inkey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
import Data.List ((\\), permutations, nub)
|
||||
import Control.Monad (join)
|
||||
|
||||
missingPerm
|
||||
:: Eq a
|
||||
=> [[a]] -> [[a]]
|
||||
missingPerm = (\\) =<< permutations . nub . join
|
||||
|
||||
deficientPermsList :: [String]
|
||||
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 :: IO ()
|
||||
main = print $ missingPerm deficientPermsList
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
import Data.List (minimumBy, group, sort, transpose)
|
||||
import Data.Ord (comparing)
|
||||
|
||||
missingPerm
|
||||
:: Ord a
|
||||
=> [[a]] -> [a]
|
||||
missingPerm = ((head . minimumBy (comparing length) . group . sort) <$>) . transpose
|
||||
|
||||
deficientPermsList :: [String]
|
||||
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 :: IO ()
|
||||
main = print $ missingPerm deficientPermsList
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
(() => {
|
||||
'use strict';
|
||||
|
||||
// MISSING PERMUTATION ---------------------------------------------------
|
||||
|
||||
// missingPermutation :: [String] -> String
|
||||
const missingPermutation = xs =>
|
||||
map(
|
||||
// Rarest letter,
|
||||
compose([
|
||||
sort,
|
||||
group,
|
||||
curry(minimumBy)(comparing(length)),
|
||||
head
|
||||
]),
|
||||
|
||||
// in each column.
|
||||
transpose(map(stringChars, xs))
|
||||
)
|
||||
.join('');
|
||||
|
||||
|
||||
// GENERIC FUNCTIONAL PRIMITIVES -----------------------------------------
|
||||
|
||||
// transpose :: [[a]] -> [[a]]
|
||||
const transpose = xs =>
|
||||
xs[0].map((_, iCol) => xs.map(row => row[iCol]));
|
||||
|
||||
// sort :: Ord a => [a] -> [a]
|
||||
const sort = xs => xs.sort();
|
||||
|
||||
// group :: Eq a => [a] -> [[a]]
|
||||
const group = xs => groupBy((a, b) => a === b, xs);
|
||||
|
||||
// groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||
const groupBy = (f, xs) => {
|
||||
const dct = xs.slice(1)
|
||||
.reduce((a, x) => {
|
||||
const
|
||||
h = a.active.length > 0 ? a.active[0] : undefined,
|
||||
blnGroup = h !== undefined && f(h, x);
|
||||
|
||||
return {
|
||||
active: blnGroup ? a.active.concat(x) : [x],
|
||||
sofar: blnGroup ? a.sofar : a.sofar.concat([a.active])
|
||||
};
|
||||
}, {
|
||||
active: xs.length > 0 ? [xs[0]] : [],
|
||||
sofar: []
|
||||
});
|
||||
return dct.sofar.concat(dct.active.length > 0 ? [dct.active] : []);
|
||||
};
|
||||
|
||||
// length :: [a] -> Int
|
||||
const length = xs => xs.length;
|
||||
|
||||
// comparing :: (a -> b) -> (a -> a -> Ordering)
|
||||
const comparing = f =>
|
||||
(x, y) => {
|
||||
const
|
||||
a = f(x),
|
||||
b = f(y);
|
||||
return a < b ? -1 : a > b ? 1 : 0
|
||||
};
|
||||
|
||||
// minimumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
const minimumBy = (f, xs) =>
|
||||
xs.reduce((a, x) => a === undefined ? x : (
|
||||
f(x, a) < 0 ? x : a
|
||||
), undefined);
|
||||
|
||||
// head :: [a] -> a
|
||||
const head = xs => xs.length ? xs[0] : undefined;
|
||||
|
||||
// map :: (a -> b) -> [a] -> [b]
|
||||
const map = (f, xs) => xs.map(f)
|
||||
|
||||
// compose :: [(a -> a)] -> (a -> a)
|
||||
const compose = fs => x => fs.reduce((a, f) => f(a), x);
|
||||
|
||||
// curry :: ((a, b) -> c) -> a -> b -> c
|
||||
const curry = f => a => b => f(a, b);
|
||||
|
||||
// stringChars :: String -> [Char]
|
||||
const stringChars = s => s.split('');
|
||||
|
||||
|
||||
// TEST ------------------------------------------------------------------
|
||||
|
||||
return missingPermutation(["ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD",
|
||||
"ADCB", "CDAB", "DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC",
|
||||
"BDCA", "DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
|
||||
]);
|
||||
|
||||
// -> "DBAC"
|
||||
})();
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
// version 1.1.2
|
||||
|
||||
fun <T> permute(input: List<T>): List<List<T>> {
|
||||
if (input.size == 1) return listOf(input)
|
||||
val perms = mutableListOf<List<T>>()
|
||||
val toInsert = input[0]
|
||||
for (perm in permute(input.drop(1))) {
|
||||
for (i in 0..perm.size) {
|
||||
val newPerm = perm.toMutableList()
|
||||
newPerm.add(i, toInsert)
|
||||
perms.add(newPerm)
|
||||
}
|
||||
}
|
||||
return perms
|
||||
}
|
||||
|
||||
fun <T> missingPerms(input: List<T>, perms: List<List<T>>) = permute(input) - perms
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val input = listOf('A', 'B', 'C', 'D')
|
||||
val strings = listOf(
|
||||
"ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB",
|
||||
"DABC", "BCAD", "CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA",
|
||||
"DCBA", "BACD", "BADC", "BDAC", "CBDA", "DBCA", "DCAB"
|
||||
)
|
||||
val perms = strings.map { it.toList() }
|
||||
val missing = missingPerms(input, perms)
|
||||
if (missing.size == 1)
|
||||
print("The missing permutation is ${missing[0].joinToString("")}")
|
||||
else {
|
||||
println("There are ${missing.size} missing permutations, namely:\n")
|
||||
for (perm in missing) println(perm.joinToString(""))
|
||||
}
|
||||
}
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
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)
|
||||
|
|
@ -1 +0,0 @@
|
|||
[1] "DBAC"
|
||||
|
|
@ -1,14 +1,15 @@
|
|||
func check_perm(arr) {
|
||||
(var hash = Hash.new).@{arr} = @[1]*arr.len;
|
||||
var hash = Hash()
|
||||
hash.set_keys(arr...)
|
||||
arr.each { |s|
|
||||
s.len.times {
|
||||
var t = (s.substr(1) + s.substr(0, 1));
|
||||
hash.has_key(t) || return t;
|
||||
}
|
||||
{
|
||||
var t = (s.substr(1) + s.substr(0, 1))
|
||||
hash.has_key(t) || return t
|
||||
} * s.len
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB)
|
||||
|
||||
say check_perm(perms);
|
||||
say check_perm(perms)
|
||||
|
|
|
|||
|
|
@ -1,24 +0,0 @@
|
|||
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"
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
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]
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
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());
|
||||
Loading…
Add table
Add a link
Reference in a new issue