Babbage problem: Difference between revisions

Content deleted Content added
Hout (talk | contribs)
→‎Haskell - Suffixes and integer roots: Faster by side-stepping stringification
Hout (talk | contribs)
→‎{{header|AppleScript}}: Added an AppleScript example (suffix + integer root test)
Line 175:
{{out}}
<pre>25264</pre>
 
=={{header|AppleScript}}==
 
AppleScript's number types are at their limits here, but we can just get to the first Babbage number, after 638 integer root tests on suffixed numbers:
 
<lang AppleScript>-- BABBAGE -------------------------------------------------------------------
 
-- babbage :: Int -> [Int]
on babbage(intTests)
script test
on toSquare(x)
(x * 1000000) + 269696
end toSquare
on |λ|(x)
hasIntRoot(toSquare(x))
end |λ|
end script
script toRoot
on |λ|(x)
((x * 1000000) + 269696) ^ (1 / 2)
end |λ|
end script
script toSquare
end script
set xs to filter(test, enumFromTo(1, intTests))
zip(map(toRoot, xs), map(test's toSquare, xs))
end babbage
 
-- TEST ----------------------------------------------------------------------
on run
-- Try 1000 candidates
unlines(map(curry(intercalate)'s |λ|(" -> "), babbage(1000)))
--> "2.5264E+4 -> 6.38269696E+8"
end run
 
 
-- GENERIC FUNCTIONS ---------------------------------------------------------
 
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on |λ|(a)
script
on |λ|(b)
|λ|(a, b) of mReturn(f)
end |λ|
end script
end |λ|
end script
end curry
 
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m > n 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
 
-- hasIntRoot :: Int -> Bool
on hasIntRoot(n)
set r to n ^ 0.5
r = (r as integer)
end hasIntRoot
 
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
 
-- 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
 
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
 
-- 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
 
-- unlines :: [String] -> String
on unlines(xs)
intercalate(linefeed, xs)
end unlines
 
-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
set lng to min(length of xs, length of ys)
set lst to {}
repeat with i from 1 to lng
set end of lst to {item i of xs, item i of ys}
end repeat
return lst
end zip</lang>
{{Out}}
<pre>2.5264E+4 -> 6.38269696E+8</pre>
 
=={{header|AutoHotkey}}==