Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,172 @@
|
|||
------------------------- NARCISSI -----------------------
|
||||
|
||||
-- isDaffodil :: Int -> Int -> Bool
|
||||
on isDaffodil(e, n)
|
||||
set ds to digitList(n)
|
||||
(e = length of ds) and (n = powerSum(e, ds))
|
||||
end isDaffodil
|
||||
|
||||
-- digitList :: Int -> [Int]
|
||||
on digitList(n)
|
||||
if n > 0 then
|
||||
{n mod 10} & digitList(n div 10)
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end digitList
|
||||
|
||||
-- powerSum :: Int -> [Int] -> Int
|
||||
on powerSum(e, ns)
|
||||
script
|
||||
on |λ|(a, x)
|
||||
a + x ^ e
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(result, 0, ns) as integer
|
||||
end powerSum
|
||||
|
||||
-- narcissiOfLength :: Int -> [Int]
|
||||
on narcissiOfLength(nDigits)
|
||||
script nthPower
|
||||
on |λ|(x)
|
||||
{x, x ^ nDigits as integer}
|
||||
end |λ|
|
||||
end script
|
||||
set powers to map(nthPower, enumFromTo(0, 9))
|
||||
|
||||
script combn
|
||||
on digitTree(n, parents)
|
||||
if n > 0 then
|
||||
if parents ≠ {} then
|
||||
script nextLayer
|
||||
on |λ|(pair)
|
||||
set {digit, intSum} to pair
|
||||
script addPower
|
||||
on |λ|(dp)
|
||||
set {d, p} to dp
|
||||
{d, p + intSum}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
map(addPower, items 1 thru (digit + 1) of powers)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set nodes to concatMap(nextLayer, parents)
|
||||
else
|
||||
set nodes to powers
|
||||
end if
|
||||
digitTree(n - 1, nodes)
|
||||
else
|
||||
script
|
||||
on |λ|(pair)
|
||||
isDaffodil(nDigits, item 2 of pair)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
filter(result, parents)
|
||||
end if
|
||||
end digitTree
|
||||
end script
|
||||
|
||||
script snd
|
||||
on |λ|(ab)
|
||||
item 2 of ab
|
||||
end |λ|
|
||||
end script
|
||||
map(snd, combn's digitTree(nDigits, {}))
|
||||
end narcissiOfLength
|
||||
|
||||
|
||||
--------------------------- TEST -------------------------
|
||||
on run
|
||||
|
||||
{0} & concatMap(narcissiOfLength, enumFromTo(1, 5))
|
||||
-- 4 seconds, 20 narcissi
|
||||
|
||||
-- {0} & concatMap(narcissiOfLength, enumFromTo(1, 6))
|
||||
-- 103 seconds, 21 narcissi
|
||||
|
||||
-- {0} & concatMap(narcissiOfLength, enumFromTo(1, 7))
|
||||
-- 13.75 minutes, 25 narcissi
|
||||
|
||||
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 & |λ|(item i of xs, i, xs))
|
||||
end repeat
|
||||
end tell
|
||||
return lst
|
||||
end concatMap
|
||||
|
||||
-- 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 |λ|(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 |λ|(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 |λ|(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
|
||||
|
|
@ -0,0 +1 @@
|
|||
{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}
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
(*
|
||||
Return the first q narcissistic decimal numbers
|
||||
(or as many of the q as can be represented by AppleScript number values).
|
||||
*)
|
||||
on narcissisticDecimalNumbers(q)
|
||||
script o
|
||||
property output : {}
|
||||
property listOfDigits : missing value
|
||||
property m : 0 -- Digits per collection/number.
|
||||
property done : false
|
||||
|
||||
-- Recursive subhandler. Builds lists containing m digit values while summing the digits' mth powers.
|
||||
on recurse(digitList, sumOfPowers, digitShortfall)
|
||||
-- If m digits have been obtained, compare the sum of powers's digits with the values in the list.
|
||||
-- Otherwise continue branching the recursion to derive longer lists.
|
||||
if (digitShortfall is 0) then
|
||||
-- Assign the list to a script property to allow faster references to its items (ie. incl. reference to script).
|
||||
set listOfDigits to digitList
|
||||
set temp to sumOfPowers
|
||||
set unmatched to m
|
||||
repeat until (temp = 0)
|
||||
set sumDigit to temp mod 10
|
||||
if (sumDigit is in digitList) then
|
||||
repeat with d from 1 to unmatched
|
||||
if (sumDigit = number d of my listOfDigits) then
|
||||
set number d of my listOfDigits to missing value
|
||||
set unmatched to unmatched - 1
|
||||
exit repeat
|
||||
end if
|
||||
end repeat
|
||||
else
|
||||
exit repeat
|
||||
end if
|
||||
set temp to temp div 10
|
||||
end repeat
|
||||
-- If all the digits have been matched, the sum of powers is narcissistic.
|
||||
if (unmatched is 0) then
|
||||
set end of my output to sumOfPowers div 1
|
||||
-- If it's the qth find, signal the end of the process.
|
||||
if ((count my output) = q) then set done to true
|
||||
end if
|
||||
else
|
||||
-- If fewer than m digits at this level, derive longer lists from the current one.
|
||||
-- Adding only values that are less than or equal to the last one makes each
|
||||
-- collection unique and turns up the narcissistic numbers in numerical order.
|
||||
repeat with additionalDigit from 0 to end of digitList
|
||||
recurse(digitList & additionalDigit, sumOfPowers + additionalDigit ^ m, digitShortfall - 1)
|
||||
if (done) then exit repeat
|
||||
end repeat
|
||||
end if
|
||||
end recurse
|
||||
end script
|
||||
|
||||
(* Rest of main handler code. *)
|
||||
if (q > 89) then set q to 89 -- Number of narcissistic decimal integers known to exist.
|
||||
set maxM to 16 -- Maximum number of decimal digits (other than trailing zeros) in AppleScript numbers.
|
||||
tell o
|
||||
-- Begin with zero, which is narcissistic by definition and is never the only digit used in other numbers.
|
||||
if (q > 0) then set end of its output to 0
|
||||
if (q < 2) then set its done to true
|
||||
-- Initiate the recursive building and testing of collections of increasing numbers of digit values.
|
||||
repeat until (its done)
|
||||
set its m to (its m) + 1
|
||||
if (its m > maxM) then
|
||||
set end of its output to "Remaining numbers beyond AppleScript's number precision"
|
||||
set its done to true
|
||||
else
|
||||
repeat with digit from 1 to 9
|
||||
recurse({digit}, digit ^ (its m), (its m) - 1)
|
||||
if (its done) then exit repeat
|
||||
end repeat
|
||||
end if
|
||||
end repeat
|
||||
|
||||
return its output
|
||||
end tell
|
||||
end narcissisticDecimalNumbers
|
||||
|
||||
return narcissisticDecimalNumbers(25)
|
||||
|
|
@ -0,0 +1 @@
|
|||
{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}
|
||||
Loading…
Add table
Add a link
Reference in a new issue