Narcissistic decimal number: Difference between revisions
→{{header|AppleScript}}: Added an AppleScript version, tho AS struggles here ...
(→{{header|AppleScript}}: Added an AppleScript version, tho AS struggles here ...) |
|||
Line 160:
0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315
</pre>
=={{header|AppleScript}}==
{{Trans|JavaScript}}
{{Trans|Haskell}}
AppleScript is out of its depth here, even with an algorithm which restricts the search space (see the JavaScript and Haskell discussions).
I have set the test here only to look for solutions with up to 5 digits (first 20 narcissistic decimal numbers). Even this takes over 5 seconds, and extending the search to 6 digits is rewarded with a result only after several minutes. Some patience would be required for the full 7 digit search that finds the 25th number.
(For comparison, equivalent code in JavaScript returns all 25 numbers in about 150 milliseconds)
<lang AppleScript>-- NARCISSI
-- powerSum :: Int -> [Int] -> Int
on powerSum(e, ns)
script
on lambda(a, x)
a + x ^ e
end lambda
end script
foldl(result, 0, ns) as integer
end powerSum
-- narcissiOfLength :: Int -> [Int]
script narcissiOfLength
on lambda(n)
script isDaffodil
on lambda(sortedDigits)
sortedDigits = quickSort(digitList(powerSum(n, sortedDigits)))
end lambda
end script
map(curry(powerSum)'s lambda(n), filter(isDaffodil, digitGroups(n)))
end lambda
end script
-- digitGroups :: Int -> [[Int]]
on digitGroups(nDigits)
script prependDesc
on lambda(xxs)
script prepend
on lambda(y)
{y} & xxs
end lambda
end script
map(prepend, enumFromTo(0, item 1 of xxs))
end lambda
end script
script pure
on lambda(x)
{x}
end lambda
end script
script possibleDigits
on sortedCombinations(n, xs)
if n > 0 then
if xs ≠ {} then
sortedCombinations(n - 1, concatMap(prependDesc, xs))
else
sortedCombinations(n - 1, map(pure, enumFromTo(0, 9)))
end if
else
xs
end if
end sortedCombinations
end script
possibleDigits's sortedCombinations(nDigits, {})
end digitGroups
-- digitList :: Int -> [Int]
on digitList(n)
if n > 0 then
{n mod 10} & digitList(n div 10)
else
{}
end if
end digitList
-- TEST -------------------------------------------------------------------
on run
{0} & concatMap(narcissiOfLength, enumFromTo(1, 5))
end run
-- GENERIC FUNCTIONS ------------------------------------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & lambda(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on lambda(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
end script
end lambda
end script
end curry
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if lambda(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- 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
-- 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
-- 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
-- partition :: predicate -> List -> (Matches, nonMatches)
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
tell mReturn(f)
set lst to {{}, {}}
repeat with x in xs
set v to contents of x
set end of item ((lambda(v) as integer) + 1) of lst to v
end repeat
end tell
{item 2 of lst, item 1 of lst}
end partition
-- pure :: a -> [a]
on pure(x)
{x}
end pure
-- quickSort :: (Ord a) => [a] -> [a]
on quickSort(xs)
if length of xs > 1 then
set h to item 1 of xs
-- lessOrEqual :: a -> Bool
script lessOrEqual
on lambda(x)
x ≤ h
end lambda
end script
set {less, more} to partition(lessOrEqual, rest of xs)
quickSort(less) & h & quickSort(more)
else
xs
end if
end quickSort
-- sum :: Num a => [a] -> a
on sum(xs)
script add
on lambda(a, b)
a + b
end lambda
end script
foldl(add, 0, xs)
end sum</lang>
{{Out}}
(Even the first 20 numbers take a good 5 or 6 seconds to return)
<lang AppleScript>{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 153, 370, 371, 407, 1634, 8208, 9474, 54748, 92727, 93084}</lang>
=={{header|AutoHotkey}}==
| |||