124 lines
2.9 KiB
AppleScript
124 lines
2.9 KiB
AppleScript
-- HAPPY NUMBERS --------------------------------------------------------------
|
|
|
|
-- isHappy :: Int -> Bool
|
|
on isHappy(n)
|
|
|
|
-- endsInOne :: [Int] -> Int -> Bool
|
|
script endsInOne
|
|
|
|
-- sumOfSquaredDigits :: Int -> Int
|
|
script sumOfSquaredDigits
|
|
|
|
-- digitSquared :: Int -> Int -> Int
|
|
script digitSquared
|
|
on |λ|(a, x)
|
|
(a + (x as integer) ^ 2) as integer
|
|
end |λ|
|
|
end script
|
|
|
|
on |λ|(n)
|
|
foldl(digitSquared, 0, splitOn("", n as string))
|
|
end |λ|
|
|
end script
|
|
|
|
-- [Int] -> Int -> Bool
|
|
on |λ|(s, n)
|
|
if n = 1 then
|
|
true
|
|
else
|
|
if s contains n then
|
|
false
|
|
else
|
|
|λ|(s & n, |λ|(n) of sumOfSquaredDigits)
|
|
end if
|
|
end if
|
|
end |λ|
|
|
end script
|
|
|
|
endsInOne's |λ|({}, n)
|
|
end isHappy
|
|
|
|
-- TEST -----------------------------------------------------------------------
|
|
on run
|
|
|
|
-- seriesLength :: {n:Int, xs:[Int]} -> Bool
|
|
script seriesLength
|
|
property target : 8
|
|
|
|
on |λ|(rec)
|
|
length of xs of rec = target of seriesLength
|
|
end |λ|
|
|
end script
|
|
|
|
-- succTest :: {n:Int, xs:[Int]} -> {n:Int, xs:[Int]}
|
|
script succTest
|
|
on |λ|(rec)
|
|
tell rec to set {xs, n} to {its xs, its n}
|
|
|
|
script testResult
|
|
on |λ|(x)
|
|
if isHappy(x) then
|
|
xs & x
|
|
else
|
|
xs
|
|
end if
|
|
end |λ|
|
|
end script
|
|
|
|
{n:n + 1, xs:testResult's |λ|(n)}
|
|
end |λ|
|
|
end script
|
|
|
|
xs of |until|(seriesLength, succTest, {n:1, xs:{}})
|
|
|
|
--> {1, 7, 10, 13, 19, 23, 28, 31}
|
|
end run
|
|
|
|
|
|
-- GENERIC FUNCTIONS ----------------------------------------------------------
|
|
|
|
-- 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
|
|
|
|
-- 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
|
|
|
|
-- 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
|
|
|
|
-- 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|
|