Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
314
Task/Sum-to-100/AppleScript/sum-to-100.applescript
Normal file
314
Task/Sum-to-100/AppleScript/sum-to-100.applescript
Normal file
|
|
@ -0,0 +1,314 @@
|
|||
use framework "Foundation" -- for basic NSArray sort
|
||||
|
||||
property pSigns : {1, 0, -1} --> ( + | unsigned | - )
|
||||
property plst100 : {"Sums to 100:", ""}
|
||||
property plstSums : {}
|
||||
property plstSumsSorted : missing value
|
||||
property plstSumGroups : missing value
|
||||
|
||||
-- data Sign :: [ 1 | 0 | -1 ] = ( Plus | Unsigned | Minus )
|
||||
-- asSum :: [Sign] -> Int
|
||||
on asSum(xs)
|
||||
script
|
||||
on |λ|(a, sign, i)
|
||||
if sign ≠ 0 then
|
||||
{digits:{}, n:(n of a) + (sign * ((i & digits of a) as string as integer))}
|
||||
else
|
||||
{digits:{i} & (digits of a), n:n of a}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set rec to foldr(result, {digits:{}, n:0}, xs)
|
||||
set ds to digits of rec
|
||||
if length of ds > 0 then
|
||||
(n of rec) + (ds as string as integer)
|
||||
else
|
||||
n of rec
|
||||
end if
|
||||
end asSum
|
||||
|
||||
-- data Sign :: [ 1 | 0 | -1 ] = ( Plus | Unisigned | Minus )
|
||||
-- asString :: [Sign] -> String
|
||||
on asString(xs)
|
||||
script
|
||||
on |λ|(a, sign, i)
|
||||
set d to i as string
|
||||
if sign ≠ 0 then
|
||||
if sign > 0 then
|
||||
a & " +" & d
|
||||
else
|
||||
a & " -" & d
|
||||
end if
|
||||
else
|
||||
a & d
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(result, "", xs)
|
||||
end asString
|
||||
|
||||
-- sumsTo100 :: () -> String
|
||||
on sumsTo100()
|
||||
-- From first permutation without leading '+' (3 ^ 8) to end of universe (3 ^ 9)
|
||||
repeat with i from 6561 to 19683
|
||||
set xs to nthPermutationWithRepn(pSigns, 9, i)
|
||||
if asSum(xs) = 100 then set end of plst100 to asString(xs)
|
||||
end repeat
|
||||
intercalate(linefeed, plst100)
|
||||
end sumsTo100
|
||||
|
||||
|
||||
-- mostCommonSum :: () -> String
|
||||
on mostCommonSum()
|
||||
-- From first permutation without leading '+' (3 ^ 8) to end of universe (3 ^ 9)
|
||||
repeat with i from 6561 to 19683
|
||||
set intSum to asSum(nthPermutationWithRepn(pSigns, 9, i))
|
||||
if intSum ≥ 0 then set end of plstSums to intSum
|
||||
end repeat
|
||||
|
||||
set plstSumsSorted to sort(plstSums)
|
||||
set plstSumGroups to group(plstSumsSorted)
|
||||
|
||||
script groupLength
|
||||
on |λ|(a, b)
|
||||
set intA to length of a
|
||||
set intB to length of b
|
||||
if intA < intB then
|
||||
-1
|
||||
else if intA > intB then
|
||||
1
|
||||
else
|
||||
0
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set lstMaxSum to maximumBy(groupLength, plstSumGroups)
|
||||
intercalate(linefeed, ¬
|
||||
{"Most common sum: " & item 1 of lstMaxSum, ¬
|
||||
"Number of instances: " & length of lstMaxSum})
|
||||
end mostCommonSum
|
||||
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
on run
|
||||
return sumsTo100()
|
||||
|
||||
-- Also returns a value, but slow:
|
||||
-- mostCommonSum()
|
||||
end run
|
||||
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
|
||||
on nthPermutationWithRepn(xs, groupSize, iIndex)
|
||||
set intBase to length of xs
|
||||
set intSetSize to intBase ^ groupSize
|
||||
|
||||
if intBase < 1 or iIndex > intSetSize then
|
||||
{}
|
||||
else
|
||||
set baseElems to inBaseElements(xs, iIndex)
|
||||
set intZeros to groupSize - (length of baseElems)
|
||||
|
||||
if intZeros > 0 then
|
||||
replicate(intZeros, item 1 of xs) & baseElems
|
||||
else
|
||||
baseElems
|
||||
end if
|
||||
end if
|
||||
end nthPermutationWithRepn
|
||||
|
||||
-- inBaseElements :: [a] -> Int -> [String]
|
||||
on inBaseElements(xs, n)
|
||||
set intBase to length of xs
|
||||
|
||||
script nextDigit
|
||||
on |λ|(residue)
|
||||
set {divided, remainder} to quotRem(residue, intBase)
|
||||
|
||||
{valid:divided > 0, value:(item (remainder + 1) of xs), new:divided}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
reverse of unfoldr(nextDigit, n)
|
||||
end inBaseElements
|
||||
|
||||
-- sort :: [a] -> [a]
|
||||
on sort(lst)
|
||||
((current application's NSArray's arrayWithArray:lst)'s ¬
|
||||
sortedArrayUsingSelector:"compare:") as list
|
||||
end sort
|
||||
|
||||
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
on maximumBy(f, xs)
|
||||
set cmp to mReturn(f)
|
||||
script max
|
||||
on |λ|(a, b)
|
||||
if a is missing value or cmp's |λ|(a, b) < 0 then
|
||||
b
|
||||
else
|
||||
a
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(max, missing value, xs)
|
||||
end maximumBy
|
||||
|
||||
-- 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 |λ|(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 |λ|(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 |λ|
|
||||
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
|
||||
|
||||
-- tail :: [a] -> [a]
|
||||
on tail(xs)
|
||||
if length of xs > 1 then
|
||||
items 2 thru -1 of xs
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end tail
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
-- quotRem :: Integral a => a -> a -> (a, a)
|
||||
on quotRem(m, n)
|
||||
{m div n, m mod n}
|
||||
end quotRem
|
||||
|
||||
-- replicate :: Int -> a -> [a]
|
||||
on replicate(n, a)
|
||||
set out to {}
|
||||
if n < 1 then return out
|
||||
set dbl to {a}
|
||||
|
||||
repeat while (n > 1)
|
||||
if (n mod 2) > 0 then set out to out & dbl
|
||||
set n to (n div 2)
|
||||
set dbl to (dbl & dbl)
|
||||
end repeat
|
||||
return out & dbl
|
||||
end replicate
|
||||
|
||||
-- foldr :: (a -> b -> 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 |λ|(v, item i of xs, i, xs)
|
||||
end repeat
|
||||
return v
|
||||
end tell
|
||||
end foldr
|
||||
|
||||
-- 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
|
||||
|
||||
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
|
||||
on unfoldr(f, v)
|
||||
set mf to mReturn(f)
|
||||
set lst to {}
|
||||
set recM to mf's |λ|(v)
|
||||
repeat while (valid of recM) is true
|
||||
set end of lst to value of recM
|
||||
set recM to mf's |λ|(new of recM)
|
||||
end repeat
|
||||
lst & value of recM
|
||||
end unfoldr
|
||||
|
||||
-- until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
on |until|(p, f, x)
|
||||
set mp to mReturn(p)
|
||||
set v to x
|
||||
|
||||
tell mReturn(f)
|
||||
repeat until mp's |λ|(v)
|
||||
set v to |λ|(v)
|
||||
end repeat
|
||||
end tell
|
||||
return v
|
||||
end |until|
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue