Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
172
Task/Weird-numbers/AppleScript/weird-numbers-1.applescript
Normal file
172
Task/Weird-numbers/AppleScript/weird-numbers-1.applescript
Normal file
|
|
@ -0,0 +1,172 @@
|
|||
on run
|
||||
take(25, weirds())
|
||||
-- Gets there, but takes about 6 seconds on this system,
|
||||
-- (logging intermediates through the Messages channel, for the impatient :-)
|
||||
end run
|
||||
|
||||
|
||||
-- weirds :: Gen [Int]
|
||||
on weirds()
|
||||
script
|
||||
property x : 1
|
||||
property v : 0
|
||||
on |λ|()
|
||||
repeat until isWeird(x)
|
||||
set x to 1 + x
|
||||
end repeat
|
||||
set v to x
|
||||
log v
|
||||
set x to 1 + x
|
||||
return v
|
||||
end |λ|
|
||||
end script
|
||||
end weirds
|
||||
|
||||
-- isWeird :: Int -> Bool
|
||||
on isWeird(n)
|
||||
set ds to descProperDivisors(n)
|
||||
set d to sum(ds) - n
|
||||
0 < d and not hasSum(d, ds)
|
||||
end isWeird
|
||||
|
||||
-- hasSum :: Int -> [Int] -> Bool
|
||||
on hasSum(n, xs)
|
||||
if {} ≠ xs then
|
||||
set h to item 1 of xs
|
||||
set t to rest of xs
|
||||
if n < h then
|
||||
hasSum(n, t)
|
||||
else
|
||||
n = h or hasSum(n - h, t) or hasSum(n, t)
|
||||
end if
|
||||
else
|
||||
false
|
||||
end if
|
||||
end hasSum
|
||||
|
||||
-- GENERIC ------------------------------------------------
|
||||
|
||||
-- descProperDivisors :: Int -> [Int]
|
||||
on descProperDivisors(n)
|
||||
if n = 1 then
|
||||
{1}
|
||||
else
|
||||
set realRoot to n ^ (1 / 2)
|
||||
set intRoot to realRoot as integer
|
||||
set blnPerfect to intRoot = realRoot
|
||||
|
||||
-- isFactor :: Int -> Bool
|
||||
script isFactor
|
||||
on |λ|(x)
|
||||
n mod x = 0
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
-- Factors up to square root of n,
|
||||
set lows to filter(isFactor, enumFromTo(1, intRoot))
|
||||
|
||||
-- and cofactors of these beyond the square root,
|
||||
|
||||
-- integerQuotient :: Int -> Int
|
||||
script integerQuotient
|
||||
on |λ|(x)
|
||||
(n / x) as integer
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set t to rest of lows
|
||||
if blnPerfect then
|
||||
set xs to t
|
||||
else
|
||||
set xs to lows
|
||||
end if
|
||||
map(integerQuotient, t) & (reverse of xs)
|
||||
end if
|
||||
end descProperDivisors
|
||||
|
||||
-- enumFromTo :: (Int, Int) -> [Int]
|
||||
on enumFromTo(m, n)
|
||||
if m ≤ n then
|
||||
set lst to {}
|
||||
repeat with i from m to n
|
||||
set end of lst to i
|
||||
end repeat
|
||||
return lst
|
||||
else
|
||||
return {}
|
||||
end if
|
||||
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
|
||||
|
||||
-- sum :: [Num] -> Num
|
||||
on sum(xs)
|
||||
script add
|
||||
on |λ|(a, b)
|
||||
a + b
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(add, 0, xs)
|
||||
end sum
|
||||
|
||||
-- take :: Int -> Gen [a] -> [a]
|
||||
on take(n, xs)
|
||||
set ys to {}
|
||||
repeat with i from 1 to n
|
||||
set v to xs's |λ|()
|
||||
if missing value is v then
|
||||
return ys
|
||||
else
|
||||
set end of ys to v
|
||||
end if
|
||||
end repeat
|
||||
return ys
|
||||
end take
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
|
||||
on mReturn(f)
|
||||
if script is class of f then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
102
Task/Weird-numbers/AppleScript/weird-numbers-2.applescript
Normal file
102
Task/Weird-numbers/AppleScript/weird-numbers-2.applescript
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
-- Sum n's proper divisors.
|
||||
on aliquotSum(n)
|
||||
if (n < 2) then return 0
|
||||
set sum to 1
|
||||
set sqrt to n ^ 0.5
|
||||
set limit to sqrt div 1
|
||||
if (limit = sqrt) then
|
||||
set sum to sum + limit
|
||||
set limit to limit - 1
|
||||
end if
|
||||
repeat with i from 2 to limit
|
||||
if (n mod i is 0) then set sum to sum + i + n div i
|
||||
end repeat
|
||||
|
||||
return sum
|
||||
end aliquotSum
|
||||
|
||||
-- Return n's proper divisors.
|
||||
on properDivisors(n)
|
||||
set output to {}
|
||||
|
||||
if (n > 1) then
|
||||
set sqrt to n ^ 0.5
|
||||
set limit to sqrt div 1
|
||||
if (limit = sqrt) then
|
||||
set end of output to limit
|
||||
set limit to limit - 1
|
||||
end if
|
||||
repeat with i from limit to 2 by -1
|
||||
if (n mod i is 0) then
|
||||
set beginning of output to i
|
||||
set end of output to n div i
|
||||
end if
|
||||
end repeat
|
||||
set beginning of output to 1
|
||||
end if
|
||||
|
||||
return output
|
||||
end properDivisors
|
||||
|
||||
-- Does a subset of the given list of numbers add up to the target value?
|
||||
on subsetOf:numberList sumsTo:target
|
||||
script o
|
||||
property lst : numberList
|
||||
property someNegatives : false
|
||||
|
||||
on ssp(target, i)
|
||||
repeat while (i > 1)
|
||||
set n to item i of my lst
|
||||
set i to i - 1
|
||||
if ((n = target) or (((n < target) or (someNegatives)) and (ssp(target - n, i)))) then return true
|
||||
end repeat
|
||||
return (target = beginning of my lst)
|
||||
end ssp
|
||||
end script
|
||||
-- The search can be more efficient if it's known the list contains no negatives.
|
||||
repeat with n in o's lst
|
||||
if (n < 0) then
|
||||
set o's someNegatives to true
|
||||
exit repeat
|
||||
end if
|
||||
end repeat
|
||||
|
||||
return o's ssp(target, count o's lst)
|
||||
end subsetOf:sumsTo:
|
||||
|
||||
-- Is n a weird number?
|
||||
on isWeird(n)
|
||||
-- Yes if its aliquot sum's greater than it and no subset of its proper divisors adds up to it.
|
||||
-- Using aliquotSum() to get the divisor sum and then calling properDivisors() too if a list's actually
|
||||
-- needed is generally faster than calling properDivisors() in the first place and summing the result.
|
||||
set sum to aliquotSum(n)
|
||||
if (sum > n) then
|
||||
set divisors to properDivisors(n)
|
||||
-- Check that no subset sums to the smaller (usually the latter) of n and sum - n.
|
||||
tell (sum - n) to if (it < n) then set n to it
|
||||
return (not (my subsetOf:divisors sumsTo:n))
|
||||
else
|
||||
return false
|
||||
end if
|
||||
end isWeird
|
||||
|
||||
-- Task code:
|
||||
on weirdNumbers(target)
|
||||
script o
|
||||
property weirds : {}
|
||||
end script
|
||||
|
||||
set n to 2
|
||||
set counter to 0
|
||||
repeat until (counter = target)
|
||||
if (isWeird(n)) then
|
||||
set end of o's weirds to n
|
||||
set counter to counter + 1
|
||||
end if
|
||||
set n to n + 1
|
||||
end repeat
|
||||
|
||||
return o's weirds
|
||||
end weirdNumbers
|
||||
|
||||
weirdNumbers(25)
|
||||
|
|
@ -0,0 +1 @@
|
|||
{70, 836, 4030, 5830, 7192, 7912, 9272, 10430, 10570, 10792, 10990, 11410, 11690, 12110, 12530, 12670, 13370, 13510, 13790, 13930, 14770, 15610, 15890, 16030, 16310}
|
||||
Loading…
Add table
Add a link
Reference in a new issue