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,133 @@
|
|||
on jacobsthalNumbers(variant, n)
|
||||
-- variant: text containing "Lucas", "oblong", or "prime" — or none of these.
|
||||
-- n: length of output sequence required.
|
||||
|
||||
-- The two Jacobsthal numbers preceding the current 'j'. Initially the first two in the sequence.
|
||||
set {anteprev, prev} to {0, 1}
|
||||
-- Default plug-in script. Its handler simply appends the current 'j' to the output.
|
||||
script o
|
||||
property output : {anteprev, prev}
|
||||
on append(dummy, j)
|
||||
set end of output to j
|
||||
end append
|
||||
end script
|
||||
|
||||
-- If a variant sequence is specified, change the first value or substitute
|
||||
-- a script whose handler decides the values to append to the output.
|
||||
ignoring case
|
||||
if (variant contains "Lucas") then
|
||||
set anteprev to 2
|
||||
set o's output's first item to anteprev
|
||||
else if (variant contains "oblong") then
|
||||
script
|
||||
property output : {0}
|
||||
on append(prev, j)
|
||||
set end of output to prev * j
|
||||
end append
|
||||
end script
|
||||
set o to result
|
||||
else if (variant contains "prime") then
|
||||
script
|
||||
property output : {}
|
||||
on append(dummy, j)
|
||||
if (isPrime(j)) then set end of output to j
|
||||
end append
|
||||
end script
|
||||
set o to result
|
||||
end if
|
||||
end ignoring
|
||||
|
||||
-- Work through the Jacobsthal process until the required output length is obtained.
|
||||
repeat until ((count o's output) = n)
|
||||
set j to anteprev + anteprev + prev
|
||||
tell o to append(prev, j)
|
||||
set anteprev to prev
|
||||
set prev to j
|
||||
end repeat
|
||||
|
||||
return o's output
|
||||
end jacobsthalNumbers
|
||||
|
||||
on isPrime(n)
|
||||
if (n < 3) then return (n is 2)
|
||||
if (n mod 2 is 0) then return false
|
||||
repeat with i from 3 to (n ^ 0.5) div 1 by 2
|
||||
if (n mod i is 0) then return false
|
||||
end repeat
|
||||
return true
|
||||
end isPrime
|
||||
|
||||
-- Task and presentation of results!:
|
||||
on intToText(n)
|
||||
set txt to ""
|
||||
repeat until (n < 100000000)
|
||||
set txt to text 2 thru 9 of (100000000 + (n mod 100000000) div 1 as text) & txt
|
||||
set n to n div 100000000
|
||||
end repeat
|
||||
return (n as integer as text) & txt
|
||||
end intToText
|
||||
|
||||
on chopList(theList, sublistLen)
|
||||
script o
|
||||
property lst : theList
|
||||
property output : {}
|
||||
end script
|
||||
|
||||
set listLen to (count o's lst)
|
||||
repeat with i from 1 to listLen by sublistLen
|
||||
set j to i + sublistLen - 1
|
||||
if (j > listLen) then set j to listLen
|
||||
set end of o's output to items i thru j of o's lst
|
||||
end repeat
|
||||
return o's output
|
||||
end chopList
|
||||
|
||||
on matrixToText(matrix, w)
|
||||
script o
|
||||
property matrix : missing value
|
||||
property row : missing value
|
||||
end script
|
||||
|
||||
set o's matrix to matrix
|
||||
set padding to " "
|
||||
repeat with r from 1 to (count o's matrix)
|
||||
set o's row to o's matrix's item r
|
||||
repeat with i from 1 to (count o's row)
|
||||
set o's row's item i to text -w thru end of (padding & o's row's item i)
|
||||
end repeat
|
||||
set o's matrix's item r to join(o's row, "")
|
||||
end repeat
|
||||
|
||||
return join(o's matrix, linefeed)
|
||||
end matrixToText
|
||||
|
||||
on join(lst, delim)
|
||||
set astid to AppleScript's text item delimiters
|
||||
set AppleScript's text item delimiters to delim
|
||||
set txt to lst as text
|
||||
set AppleScript's text item delimiters to astid
|
||||
return txt
|
||||
end join
|
||||
|
||||
on task()
|
||||
set output to {"First 30 Jacobsthal Numbers:", "First 30 Jacobsthal-Lucas Numbers:", ¬
|
||||
"First 20 Jacobsthal oblong Numbers:", "First 11 Jacobsthal Primes:"}
|
||||
set results to {jacobsthalNumbers("", 30), jacobsthalNumbers("Lucas", 30), ¬
|
||||
jacobsthalNumbers("oblong", 20), jacobsthalNumbers("prime", 11)}
|
||||
repeat with i from 1 to 4
|
||||
set thisSequence to item i of results
|
||||
repeat with j in thisSequence
|
||||
set j's contents to intToText(j)
|
||||
end repeat
|
||||
if (i < 4) then
|
||||
set theLines to chopList(thisSequence, 10)
|
||||
else
|
||||
set theLines to chopList(thisSequence, 6)
|
||||
end if
|
||||
set item i of output to item i of output & linefeed & matrixToText(theLines, (count end of thisSequence) + 1)
|
||||
end repeat
|
||||
|
||||
return join(output, linefeed & linefeed)
|
||||
end task
|
||||
|
||||
task()
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
"First 30 Jacobsthal Numbers:
|
||||
0 1 1 3 5 11 21 43 85 171
|
||||
341 683 1365 2731 5461 10923 21845 43691 87381 174763
|
||||
349525 699051 1398101 2796203 5592405 11184811 22369621 44739243 89478485 178956971
|
||||
|
||||
First 30 Jacobsthal-Lucas Numbers:
|
||||
2 1 5 7 17 31 65 127 257 511
|
||||
1025 2047 4097 8191 16385 32767 65537 131071 262145 524287
|
||||
1048577 2097151 4194305 8388607 16777217 33554431 67108865 134217727 268435457 536870911
|
||||
|
||||
First 20 Jacobsthal oblong Numbers:
|
||||
0 1 3 15 55 231 903 3655 14535 58311
|
||||
232903 932295 3727815 14913991 59650503 238612935 954429895 3817763271 15270965703 61084037575
|
||||
|
||||
First 11 Jacobsthal Primes:
|
||||
3 5 11 43 683 2731
|
||||
43691 174763 2796203 715827883 2932031007403"
|
||||
|
|
@ -0,0 +1,436 @@
|
|||
-------------------- JACOBSTHAL NUMBERS ------------------
|
||||
|
||||
-- e.g. take(10, jacobsthal())
|
||||
|
||||
-- jacobsthal :: [Int]
|
||||
on jacobsthal()
|
||||
-- The terms of OEIS:A001045 as a non-finite sequence.
|
||||
jacobsthalish(0, 1)
|
||||
end jacobsthal
|
||||
|
||||
|
||||
-- jacobsthal :: (Int, Int) -> [Int]
|
||||
on jacobsthalish(x, y)
|
||||
-- An infinite sequence of the terms of the
|
||||
-- Jacobsthal-type series which begins with x and y.
|
||||
script go
|
||||
on |λ|(ab)
|
||||
set {a, b} to ab
|
||||
|
||||
{a, {b, (2 * a) + b}}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
unfoldr(go, {x, y})
|
||||
end jacobsthalish
|
||||
|
||||
|
||||
-------------------------- TESTS -------------------------
|
||||
on run
|
||||
unlines(map(fShow, {¬
|
||||
{"terms of the Jacobsthal sequence", ¬
|
||||
30, jacobsthal()}, ¬
|
||||
{"Jacobsthal-Lucas numbers", ¬
|
||||
30, jacobsthalish(2, 1)}, ¬
|
||||
{"Jacobsthal oblong numbers", ¬
|
||||
20, zipWith(my mul, jacobsthal(), drop(1, jacobsthal()))}, ¬
|
||||
{"primes in the Jacobsthal sequence", ¬
|
||||
10, filter(isPrime, jacobsthal())}}))
|
||||
end run
|
||||
|
||||
|
||||
------------------------ FORMATTING ----------------------
|
||||
on fShow(test)
|
||||
set {k, n, xs} to test
|
||||
|
||||
str(n) & " first " & k & ":" & linefeed & ¬
|
||||
table(5, map(my str, take(n, xs))) & linefeed
|
||||
end fShow
|
||||
|
||||
|
||||
-- justifyRight :: Int -> Char -> String -> String
|
||||
on justifyRight(n, cFiller)
|
||||
script go
|
||||
on |λ|(s)
|
||||
if n > length of s then
|
||||
text -n thru -1 of ((replicate(n, cFiller) as text) & s)
|
||||
else
|
||||
s
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end justifyRight
|
||||
|
||||
|
||||
-- Egyptian multiplication - progressively doubling a list, appending
|
||||
-- stages of doubling to an accumulator where needed for binary
|
||||
-- assembly of a target length
|
||||
-- replicate :: Int -> String -> String
|
||||
on replicate(n, s)
|
||||
-- Egyptian multiplication - progressively doubling a list,
|
||||
-- appending stages of doubling to an accumulator where needed
|
||||
-- for binary assembly of a target length
|
||||
script p
|
||||
on |λ|({n})
|
||||
n ≤ 1
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
script f
|
||||
on |λ|({n, dbl, out})
|
||||
if (n mod 2) > 0 then
|
||||
set d to out & dbl
|
||||
else
|
||||
set d to out
|
||||
end if
|
||||
{n div 2, dbl & dbl, d}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set xs to |until|(p, f, {n, s, ""})
|
||||
item 2 of xs & item 3 of xs
|
||||
end replicate
|
||||
|
||||
|
||||
-- table :: Int -> [String] -> String
|
||||
on table(n, xs)
|
||||
-- A list of strings formatted as
|
||||
-- right-justified rows of n columns.
|
||||
set w to length of last item of xs
|
||||
unlines(map(my unwords, ¬
|
||||
chunksOf(n, map(justifyRight(w, space), xs))))
|
||||
end table
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
on |until|(p, f, x)
|
||||
set v to x
|
||||
set mp to mReturn(p)
|
||||
set mf to mReturn(f)
|
||||
repeat until mp's |λ|(v)
|
||||
set v to mf's |λ|(v)
|
||||
end repeat
|
||||
v
|
||||
end |until|
|
||||
|
||||
|
||||
-- unwords :: [String] -> String
|
||||
on unwords(xs)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, space}
|
||||
set s to xs as text
|
||||
set my text item delimiters to dlm
|
||||
return s
|
||||
end unwords
|
||||
|
||||
|
||||
------------------------- GENERIC ------------------------
|
||||
|
||||
-- Just :: a -> Maybe a
|
||||
on Just(x)
|
||||
-- Constructor for an inhabited Maybe (option type) value.
|
||||
-- Wrapper containing the result of a computation.
|
||||
{type:"Maybe", Nothing:false, Just:x}
|
||||
end Just
|
||||
|
||||
|
||||
-- Nothing :: Maybe a
|
||||
on Nothing()
|
||||
-- Constructor for an empty Maybe (option type) value.
|
||||
-- Empty wrapper returned where a computation is not possible.
|
||||
{type:"Maybe", Nothing:true}
|
||||
end Nothing
|
||||
|
||||
|
||||
-- abs :: Num -> Num
|
||||
on abs(x)
|
||||
-- Absolute value.
|
||||
if 0 > x then
|
||||
-x
|
||||
else
|
||||
x
|
||||
end if
|
||||
end abs
|
||||
|
||||
|
||||
-- any :: (a -> Bool) -> [a] -> Bool
|
||||
on any(p, xs)
|
||||
-- Applied to a predicate and a list,
|
||||
-- |any| returns true if at least one element of the
|
||||
-- list satisfies the predicate.
|
||||
tell mReturn(p)
|
||||
set lng to length of xs
|
||||
repeat with i from 1 to lng
|
||||
if |λ|(item i of xs) then return true
|
||||
end repeat
|
||||
false
|
||||
end tell
|
||||
end any
|
||||
|
||||
|
||||
-- chunksOf :: Int -> [a] -> [[a]]
|
||||
on chunksOf(k, xs)
|
||||
script
|
||||
on go(ys)
|
||||
set ab to splitAt(k, ys)
|
||||
set a to item 1 of ab
|
||||
if {} ≠ a then
|
||||
{a} & go(item 2 of ab)
|
||||
else
|
||||
a
|
||||
end if
|
||||
end go
|
||||
end script
|
||||
result's go(xs)
|
||||
end chunksOf
|
||||
|
||||
|
||||
-- drop :: Int -> [a] -> [a]
|
||||
-- drop :: Int -> String -> String
|
||||
on drop(n, xs)
|
||||
take(n, xs) -- consumed
|
||||
xs
|
||||
end drop
|
||||
|
||||
|
||||
-- enumFromThenTo :: Int -> Int -> Int -> [Int]
|
||||
on enumFromThenTo(x1, x2, y)
|
||||
set xs to {}
|
||||
set gap to x2 - x1
|
||||
set d to max(1, abs(gap)) * (signum(gap))
|
||||
repeat with i from x1 to y by d
|
||||
set end of xs to i
|
||||
end repeat
|
||||
return xs
|
||||
end enumFromThenTo
|
||||
|
||||
|
||||
-- filter :: (a -> Bool) -> Gen [a] -> Gen [a]
|
||||
on filter(p, gen)
|
||||
-- Non-finite stream of values which are
|
||||
-- drawn from gen, and satisfy p
|
||||
script
|
||||
property mp : mReturn(p)'s |λ|
|
||||
on |λ|()
|
||||
set v to gen's |λ|()
|
||||
repeat until mp(v)
|
||||
set v to gen's |λ|()
|
||||
end repeat
|
||||
return v
|
||||
end |λ|
|
||||
end script
|
||||
end filter
|
||||
|
||||
|
||||
-- isPrime :: Int -> Bool
|
||||
on isPrime(n)
|
||||
-- True if n is prime
|
||||
|
||||
if {2, 3} contains n then return true
|
||||
|
||||
if 2 > n or 0 = (n mod 2) then return false
|
||||
|
||||
if 9 > n then return true
|
||||
|
||||
if 0 = (n mod 3) then return false
|
||||
|
||||
script p
|
||||
on |λ|(x)
|
||||
0 = n mod x or 0 = n mod (2 + x)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
not any(p, enumFromThenTo(5, 11, 1 + (n ^ 0.5)))
|
||||
end isPrime
|
||||
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on |length|(xs)
|
||||
set c to class of xs
|
||||
if list is c or string is c then
|
||||
length of xs
|
||||
else
|
||||
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
|
||||
end if
|
||||
end |length|
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- max :: Ord a => a -> a -> a
|
||||
on max(x, y)
|
||||
if x > y then
|
||||
x
|
||||
else
|
||||
y
|
||||
end if
|
||||
end max
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- mul (*) :: Num a => a -> a -> a
|
||||
on mul(a, b)
|
||||
a * b
|
||||
end mul
|
||||
|
||||
|
||||
-- signum :: Num -> Num
|
||||
on signum(x)
|
||||
if x < 0 then
|
||||
-1
|
||||
else if x = 0 then
|
||||
0
|
||||
else
|
||||
1
|
||||
end if
|
||||
end signum
|
||||
|
||||
|
||||
-- splitAt :: Int -> [a] -> ([a], [a])
|
||||
on splitAt(n, xs)
|
||||
if n > 0 and n < length of xs then
|
||||
if class of xs is text then
|
||||
{items 1 thru n of xs as text, ¬
|
||||
items (n + 1) thru -1 of xs as text}
|
||||
else
|
||||
{items 1 thru n of xs, items (n + 1) thru -1 of xs}
|
||||
end if
|
||||
else
|
||||
if n < 1 then
|
||||
{{}, xs}
|
||||
else
|
||||
{xs, {}}
|
||||
end if
|
||||
end if
|
||||
end splitAt
|
||||
|
||||
|
||||
-- str :: a -> String
|
||||
on str(x)
|
||||
x as string
|
||||
end str
|
||||
|
||||
|
||||
-- take :: Int -> [a] -> [a]
|
||||
-- take :: Int -> String -> String
|
||||
on take(n, xs)
|
||||
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
|
||||
end take
|
||||
|
||||
|
||||
-- uncons :: [a] -> Maybe (a, [a])
|
||||
on uncons(xs)
|
||||
set lng to |length|(xs)
|
||||
if 0 = lng then
|
||||
Nothing()
|
||||
else
|
||||
if (2 ^ 29 - 1) as integer > lng then
|
||||
if class of xs is string then
|
||||
set cs to text items of xs
|
||||
Just({item 1 of cs, rest of cs})
|
||||
else
|
||||
Just({item 1 of xs, rest of xs})
|
||||
end if
|
||||
else
|
||||
set nxt to take(1, xs)
|
||||
if {} is nxt then
|
||||
Nothing()
|
||||
else
|
||||
Just({item 1 of nxt, xs})
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end uncons
|
||||
|
||||
|
||||
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
|
||||
on unfoldr(f, v)
|
||||
-- A lazy (generator) list unfolded from a seed value
|
||||
-- by repeated application of f to a value until no
|
||||
-- residue remains. Dual to fold/reduce.
|
||||
-- f returns either nothing (missing value)
|
||||
-- or just (value, residue).
|
||||
script
|
||||
property valueResidue : {v, v}
|
||||
property g : mReturn(f)
|
||||
on |λ|()
|
||||
set valueResidue to g's |λ|(item 2 of (valueResidue))
|
||||
if missing value ≠ valueResidue then
|
||||
item 1 of (valueResidue)
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end unfoldr
|
||||
|
||||
|
||||
-- zipWith :: (a -> b -> c) -> Gen [a] -> Gen [b] -> Gen [c]
|
||||
on zipWith(f, ga, gb)
|
||||
script
|
||||
property ma : missing value
|
||||
property mb : missing value
|
||||
property mf : mReturn(f)
|
||||
on |λ|()
|
||||
if missing value is ma then
|
||||
set ma to uncons(ga)
|
||||
set mb to uncons(gb)
|
||||
end if
|
||||
if Nothing of ma or Nothing of mb then
|
||||
missing value
|
||||
else
|
||||
set ta to Just of ma
|
||||
set tb to Just of mb
|
||||
set ma to uncons(item 2 of ta)
|
||||
set mb to uncons(item 2 of tb)
|
||||
|λ|(item 1 of ta, item 1 of tb) of mf
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end zipWith
|
||||
Loading…
Add table
Add a link
Reference in a new issue