Self-describing numbers: Difference between revisions
Content added Content deleted
m (→even faster: while -> for) |
(→{{header|AppleScript}}: Added a draft 'selfDescribes' predicate in Applescript) |
||
Line 118: | Line 118: | ||
+42101000 is self describing |
+42101000 is self describing |
||
</pre> |
</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}}== |
=={{header|AutoHotkey}}== |