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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Task/Find-the-missing-permutation/Aime/find-the-missing-permutation.aime
View file

@ -1,12 +1,12 @@
void
paste(record r, index x, data p, integer a,)
paste(record r, index x, text 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);
p = insert(p, -1, a);
x.delete(a);
if (~x) {
x.vcall(paste, -1, r, x, p);
} else {
r[b_string(p)] = 0;
r[p] = 0;
}
x[a] = 0;
}
@ -17,20 +17,18 @@ main(void)
record r;
list l;
index x;
data p;
l_bill(l, 0, "ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB",
l.bill(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);
x['A'] = x['B'] = x['C'] = x['D'] = 0;
b_size(p, 4);
i_wcall(x, paste, -1, -1, r, x, p);
x.vcall(paste, -1, r, x, "");
l_ucall(l, r_delete, 1, r);
l.ucall(r_delete, 1, r);
o_(r_low(r), "\n");
o_(r.low, "\n");
return 0;
}

315
Task/Find-the-missing-permutation/AppleScript/find-the-missing-permutation.applescript
View file

@ -1,143 +1,131 @@
use framework "Foundation" -- ( sort )
-- RAREST LETTER IN EACH COLUMN -----------------------------------------------
-- RAREST LETTER IN EACH COLUMN ----------------------------------------------
on run
intercalate("", ¬
map(compose({¬
sort, ¬
map(composeAll({¬
head, ¬
curry(minimumBy)'s |λ|(comparing(|length|)), ¬
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"))))))
sort}), ¬
transpose(map(chars, ¬
|words|("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 ----------------------------------------------------------
-- 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
-- chars :: String -> [String]
on chars(s)
characters of s
end chars
foldl(result, x, fs)
end lambda
end script
end compose
-- transpose :: [[a]] -> [[a]]
on transpose(xss)
script column
on lambda(_, iCol)
script row
on lambda(xs)
item iCol of xs
end lambda
end script
map(row, xss)
end lambda
end script
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
-- Ordering :: (-1 | 0 | 1)
-- compare :: a -> a -> Ordering
on compare(a, b)
if a < b then
-1
else if a > b then
1
else
0
end if
end compare
-- 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
on |λ|(a, b)
tell mReturn(f) to compare(|λ|(a), |λ|(b))
end |λ|
end script
end comparing
-- composeAll :: [(a -> a)] -> (a -> a)
on composeAll(fs)
script
on |λ|(x)
script
on |λ|(f, a)
mReturn(f)'s |λ|(a)
end |λ|
end script
foldr(result, x, fs)
end |λ|
end script
end composeAll
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on lambda(a)
on |λ|(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
on |λ|(b)
|λ|(a, b) of mReturn(f)
end |λ|
end script
end lambda
end |λ|
end script
end curry
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- foldr :: (b -> a -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to |λ|(item i of xs, v, i, xs)
end repeat
return v
end tell
end foldr
-- group :: Eq a => [a] -> [[a]]
on group(xs)
script eq
on |λ|(a, b)
a = b
end |λ|
end script
groupBy(eq, xs)
end group
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
set mf to mReturn(f)
script enGroup
on lambda(a, x)
on |λ|(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
if h is not missing value and mf's |λ|(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 |λ|
end script
if length of xs > 0 then
@ -161,6 +149,61 @@ on head(xs)
end if
end head
-- 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
-- length :: [a] -> Int
on |length|(xs)
length of xs
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- minimumBy :: (a -> a -> Ordering) -> [a] -> a
on minimumBy(f, xs)
if length of xs < 1 then return missing value
tell mReturn(f)
set v to item 1 of xs
repeat with x in xs
if |λ|(x, v) < 0 then set v to x
end repeat
return v
end tell
end minimumBy
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- sort :: [a] -> [a]
on sort(xs)
((current application's NSArray's arrayWithArray:xs)'s ¬
sortedArrayUsingSelector:"compare:") as list
end sort
-- tail :: [a] -> [a]
on tail(xs)
if length of xs > 1 then
@ -170,64 +213,24 @@ on tail(xs)
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
-- transpose :: [[a]] -> [[a]]
on transpose(xss)
script column
on |λ|(_, iCol)
script row
on |λ|(xs)
item iCol of xs
end |λ|
end script
-- stringChars :: String -> [Char]
on stringChars(s)
characters of s
end stringChars
map(row, xss)
end |λ|
end script
-- length :: [a] -> Int
on _length(xs)
length of xs
end _length
map(column, item 1 of xss)
end transpose
-- 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)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn
-- words :: String -> [String]
on |words|(s)
words of s
end |words|

3
Task/Find-the-missing-permutation/Factor/find-the-missing-permutation.factor Normal file
View file

@ -0,0 +1,3 @@
USING: io math.combinatorics sequences sets ;
"ABCD" all-permutations lines diff first print

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

@ -1,15 +1,13 @@
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
using Combinatorics
function missingperm(arr::Vector)
allperms = permutations(arr[1])
for perm in allperms
perm = convert(eltype(arr), perm)
if perm ∉ arr return perm end
end
mperms = T[]
for i in findn(needsperm)[1]
push!(mperms, join(nthperm(std, i), ""))
end
return mperms
end
arr = ["ABCD", "CABD", "ACDB", "DACB", "BCDA", "ACBD", "ADCB", "CDAB", "DABC", "BCAD",
"CADB", "CDBA", "CBAD", "ABDC", "ADBC", "BDCA", "DCBA", "BACD", "BADC", "BDAC",
"CBDA", "DBCA", "DCAB"]
@show missingperm(arr)

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

@ -1,24 +1,17 @@
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)
function missingperm1(arr::Vector{<:AbstractString})
missperm = string()
for pos in 1:length(arr[1])
s = Set()
for perm in arr
c = perm[pos]
if c ∈ s pop!(s, c) else push!(s, c) end
end
missperm *= first(s)
end
else
println("There are no missing permutations.")
return missperm
end
using BenchmarkTools
@btime missingperm(arr)
@btime missingperm1(arr)

11
Task/Find-the-missing-permutation/Maple/find-the-missing-permutation.maple Normal file
View file

@ -0,0 +1,11 @@
lst := ["ABCD","CABD","ACDB","DACB","BCDA","ACBD","ADCB","CDAB","DABC","BCAD","CADB","CDBA","CBAD","ABDC","ADBC","BDCA","DCBA","BACD","BADC","BDAC","CBDA","DBCA","DCAB"]:
perm := table():
for letter in "ABCD" do
perm[letter] := 0:
end do:
for item in lst do
for letter in "ABCD" do
perm[letter] += StringTools:-FirstFromLeft(letter, item):
end do:
end do:
print(StringTools:-Join(ListTools:-Flatten([indices(perm)], 4)[sort(map(x->60-x, ListTools:-Flatten([entries(perm)],4)),'output=permutation')], "")):

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

@ -1 +1,2 @@
say [~^] @givens;
say [~^] <ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA
CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB>;