Self-describing numbers: Difference between revisions
→{{header|AppleScript}}: Added a draft 'selfDescribes' predicate in Applescript
m (→even faster: while -> for) |
(→{{header|AppleScript}}: Added a draft 'selfDescribes' predicate in Applescript) |
||
Line 118:
+42101000 is self describing
</pre>
=={{header|AppleScript}}==
<lang applescript>use AppleScript version "2.4"
use framework "Foundation"
use scripting additions
-- selfDescribes :: Int -> Bool
on selfDescribes(x)
set s to str(x)
set descripn to |λ|(my groupBy(my eq, my sort(characters of s))) of my described({¬
"0", "1", "2", "3", "4", "5", "6", "7", "8", "9"})
1 = (offset of my str(descripn) in s)
end selfDescribes
-- described :: [Char] -> [[Char]] -> [Char]
on described(digits)
script
on |λ|(groups)
if 0 < length of digits and 0 < length of groups then
set grp to item 1 of groups
set go to described(rest of digits)
if item 1 of digits = item 1 of (item 1 of grp) then
{item 1 of my str(length of grp)} & |λ|(rest of groups) of go
else
{"0"} & |λ|(groups) of go
end if
else
{}
end if
end |λ|
end script
end described
-------------------------- TEST ---------------------------
on run
script test
on |λ|(n)
str(n) & " -> " & str(selfDescribes(n))
end |λ|
end script
unlines(map(test, ¬
{1210, 1211, 2020, 2022, 21200, 21203, 3211000, 3211004}))
end run
-------------------- GENERIC FUNCTIONS --------------------
-- eq (==) :: Eq a => a -> a -> Bool
on eq(a, b)
a = b
end eq
-- 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
-- Typical usage: groupBy(on(eq, f), xs)
-- 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:{}}, rest of 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
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of 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
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- sort :: Ord a => [a] -> [a]
on sort(xs)
((current application's NSArray's arrayWithArray:xs)'s ¬
sortedArrayUsingSelector:"compare:") as list
end sort
-- str :: a -> String
on str(x)
x as string
end str
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set s to xs as text
set my text item delimiters to dlm
s
end unlines</lang>
{{Out}}
<pre>1210 -> true
1211 -> false
2020 -> true
2022 -> false
21200 -> true
21203 -> false
3211000 -> true
3211004 -> false</pre>
=={{header|AutoHotkey}}==
| |||