Jacobsthal numbers: Difference between revisions
→{{header|AppleScript}}: Added a functionally composed variant to the existing procedural example.
(→{{header|AppleScript}}: Added a functionally composed variant to the existing procedural example.) |
|||
Line 150:
=={{header|AppleScript}}==
===Procedural===
<lang applescript>on jacobsthalNumbers(variant, n)
-- variant: text containing "Lucas", "oblong", or "prime" — or none of these.
Line 303 ⟶ 304:
3 5 11 43 683 2731
43691 174763 2796203 715827883 2932031007403"</lang>
===Functional===
<lang applescript>-------------------- 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(xy)
-- 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, xy)
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</lang>
{{Out}}
<pre>30 first terms of the Jacobsthal sequence:
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
30 first 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
20 first Jacobsthal oblong numbers:
0 1 3 15 55
231 903 3655 14535 58311
232903 932295 3727815 14913991 59650503
238612935 9.54429895E+8 3.817763271E+9 1.5270965703E+10 6.1084037575E+10
10 first primes in the Jacobsthal sequence:
3 5 11 43 683
2731 43691 174763 2796203 7.15827883E+8</pre>
=={{header|C}}==
| |||