Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
24
Task/Fusc-sequence/AppleScript/fusc-sequence-1.applescript
Normal file
24
Task/Fusc-sequence/AppleScript/fusc-sequence-1.applescript
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
on fusc(n)
|
||||
if (n < 2) then
|
||||
return n
|
||||
else if (n mod 2 is 0) then
|
||||
return fusc(n div 2)
|
||||
else
|
||||
return fusc((n - 1) div 2) + fusc((n + 1) div 2)
|
||||
end if
|
||||
end fusc
|
||||
|
||||
set sequence to {}
|
||||
set longestSoFar to 0
|
||||
repeat with i from 0 to 60
|
||||
set fuscNumber to fusc(i)
|
||||
set end of sequence to fuscNumber
|
||||
set len to (count (fuscNumber as text))
|
||||
if (len > longestSoFar) then
|
||||
set longestSoFar to len
|
||||
set firstLongest to fuscNumber
|
||||
set indexThereof to i + 1 -- AppleScript indices are 1-based.
|
||||
end if
|
||||
end repeat
|
||||
|
||||
return {sequence:sequence, firstLongest:firstLongest, indexThereof:indexThereof}
|
||||
265
Task/Fusc-sequence/AppleScript/fusc-sequence-2.applescript
Normal file
265
Task/Fusc-sequence/AppleScript/fusc-sequence-2.applescript
Normal file
|
|
@ -0,0 +1,265 @@
|
|||
-- fusc :: [Int]
|
||||
on fusc()
|
||||
-- Terms of the Fusc sequence
|
||||
-- OEIS A2487
|
||||
|
||||
script go
|
||||
on |λ|(step)
|
||||
set {isEven, n, xxs} to step
|
||||
set x to item 1 of xxs
|
||||
|
||||
if isEven then
|
||||
set nxt to n + x
|
||||
{not isEven, nxt, xxs & {nxt}}
|
||||
else
|
||||
{not isEven, x, rest of xxs & {x}}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
appendGen(gen({0, 1}), ¬
|
||||
fmapGen(my snd, iterate(go, {true, 1, {1}})))
|
||||
end fusc
|
||||
|
||||
-------------------------- TEST ---------------------------
|
||||
on run
|
||||
unlines({¬
|
||||
"First 61 terms:", ¬
|
||||
showList(take(61, fusc())), ¬
|
||||
"", ¬
|
||||
"First term of each decimal magnitude:", ¬
|
||||
"(Index, Term):"} & ¬
|
||||
map(showTuple, take(4, firstFuscOfEachMagnitude())))
|
||||
end run
|
||||
|
||||
|
||||
---------- FIRST FUSC OF EACH DECIMAL MAGNITUDE -----------
|
||||
|
||||
-- firstFuscOfEachMagnitude :: [(Int, Int)]
|
||||
on firstFuscOfEachMagnitude()
|
||||
-- [(Index, Term)] list of of the first Fusc
|
||||
-- terms of each decimal magnitude.
|
||||
script
|
||||
property e : -1
|
||||
property i : 0
|
||||
on |λ|()
|
||||
set e to 1 + e
|
||||
set p to 10 ^ e
|
||||
set v to fuscTerm(i)
|
||||
repeat until p ≤ v
|
||||
set i to 1 + i
|
||||
set v to fuscTerm(i)
|
||||
end repeat
|
||||
{i, v}
|
||||
end |λ|
|
||||
end script
|
||||
end firstFuscOfEachMagnitude
|
||||
|
||||
|
||||
-- fuscTerm :: Int -> Int
|
||||
on fuscTerm(n)
|
||||
-- Nth term (zero-indexed) of the Fusc series.
|
||||
script go
|
||||
on |λ|(i)
|
||||
if 0 = i then
|
||||
{1, 0}
|
||||
else
|
||||
set {x, y} to |λ|(i div 2)
|
||||
if 0 = i mod 2 then
|
||||
{x + y, y}
|
||||
else
|
||||
{x, x + y}
|
||||
end if
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
tell go
|
||||
if 1 > n then
|
||||
0
|
||||
else
|
||||
item 1 of |λ|(n - 1)
|
||||
end if
|
||||
end tell
|
||||
end fuscTerm
|
||||
|
||||
|
||||
|
||||
-------------------- GENERIC FUNCTIONS --------------------
|
||||
|
||||
-- appendGen (++) :: Gen [a] -> Gen [a] -> Gen [a]
|
||||
on appendGen(xs, ys)
|
||||
script
|
||||
property vs : xs
|
||||
on |λ|()
|
||||
set v to |λ|() of vs
|
||||
if missing value is not v then
|
||||
v
|
||||
else
|
||||
set vs to ys
|
||||
|λ|() of ys
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end appendGen
|
||||
|
||||
|
||||
-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
|
||||
on fmapGen(f, gen)
|
||||
script
|
||||
property g : mReturn(f)
|
||||
on |λ|()
|
||||
set v to gen's |λ|()
|
||||
if v is missing value then
|
||||
v
|
||||
else
|
||||
g's |λ|(v)
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end fmapGen
|
||||
|
||||
|
||||
-- intercalate :: String -> [String] -> String
|
||||
on intercalate(delim, xs)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, delim}
|
||||
set s to xs as text
|
||||
set my text item delimiters to dlm
|
||||
s
|
||||
end intercalate
|
||||
|
||||
|
||||
-- iterate :: (a -> a) -> a -> Gen [a]
|
||||
on iterate(f, x)
|
||||
script
|
||||
property v : missing value
|
||||
property g : mReturn(f)'s |λ|
|
||||
on |λ|()
|
||||
if missing value is v then
|
||||
set v to x
|
||||
else
|
||||
set v to g(v)
|
||||
end if
|
||||
return v
|
||||
end |λ|
|
||||
end script
|
||||
end iterate
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- gen :: [a] -> Gen a
|
||||
on gen(xs)
|
||||
script go
|
||||
property lng : length of xs
|
||||
property i : 0
|
||||
on |λ|()
|
||||
if i ≥ lng then
|
||||
missing value
|
||||
else
|
||||
set i to 1 + i
|
||||
item i of xs
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end gen
|
||||
|
||||
|
||||
-- showList :: [a] -> String
|
||||
on showList(xs)
|
||||
"[" & intercalate(", ", my map(my str, xs)) & "]"
|
||||
end showList
|
||||
|
||||
|
||||
-- showTuple :: (,) -> String
|
||||
on showTuple(xs)
|
||||
"(" & intercalate(", ", my map(my str, xs)) & ")"
|
||||
end showTuple
|
||||
|
||||
|
||||
-- snd :: (a, b) -> b
|
||||
on snd(tpl)
|
||||
if class of tpl is record then
|
||||
|2| of tpl
|
||||
else
|
||||
item 2 of tpl
|
||||
end if
|
||||
end snd
|
||||
|
||||
|
||||
-- str :: a -> String
|
||||
on str(x)
|
||||
x as string
|
||||
end str
|
||||
|
||||
|
||||
-- take :: Int -> [a] -> [a]
|
||||
-- take :: Int -> String -> String
|
||||
on take(n, xs)
|
||||
set c to class of xs
|
||||
if list is c then
|
||||
if 0 < n then
|
||||
items 1 thru min(n, length of xs) of xs
|
||||
else
|
||||
{}
|
||||
end if
|
||||
else if string is c then
|
||||
if 0 < n then
|
||||
text 1 thru min(n, length of xs) of xs
|
||||
else
|
||||
""
|
||||
end if
|
||||
else if script is c then
|
||||
set ys to {}
|
||||
repeat with i from 1 to n
|
||||
set v to |λ|() of xs
|
||||
if missing value is v then
|
||||
return ys
|
||||
else
|
||||
set end of ys to v
|
||||
end if
|
||||
end repeat
|
||||
return ys
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end take
|
||||
|
||||
|
||||
-- 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue