Pascal's triangle: Difference between revisions

Content added Content deleted
(Added Fōrmulæ)
(→‎{{header|AppleScript}}: Updated primitives and approach)
Line 308: Line 308:


=={{header|AppleScript}}==
=={{header|AppleScript}}==
<lang AppleScript>-- PASCAL ---------------------------------------------------------------------


Drawing n rows from a generator:
-- pascal :: Int -> [[Int]]

on pascal(intRows)
<lang AppleScript>
-- pascal :: Generator [[Int]]
script addRow
on nextRow(row)
on pascal()
script add
script nextRow
on |λ|(a, b)
on |λ|(row)
a + b
zipWith(my plus, {0} & row, row & {0})
end |λ|
end script
zipWith(add, [0] & row, row & [0])
end nextRow
on |λ|(xs)
xs & {nextRow(item -1 of xs)}
end |λ|
end |λ|
end script
end script
iterate(nextRow, {1})
foldr(addRow, {{1}}, enumFromTo(1, intRows - 1))
end pascal
end pascal


-- TEST -----------------------------------------------------------------------
-- TEST ------------------------------------------------
on run
on run
set lstTriangle to pascal(7)
showPascal(take(7, pascal()))
end run

script spaced

on |λ|(xs)
-- showPascal :: [[Int]] -> String
script rightAlign
on showPascal(xs)
on |λ|(x)
text -4 thru -1 of (" " & x)
set w to length of intercalate(" ", item -1 of xs)
script align
end |λ|
end script
on |λ|(x)
|center|(w, space, intercalate(" ", x))
intercalate("", map(rightAlign, xs))
end |λ|
end |λ|
end script
end script
unlines(map(align, xs))
end showPascal
script indented
on |λ|(a, x)
set strIndent to leftSpace of a
{rows:¬
strIndent & x & linefeed & rows of a, leftSpace:¬
leftSpace of a & " "} ¬
end |λ|
end script
rows of foldr(indented, ¬
{rows:"", leftSpace:""}, map(spaced, lstTriangle))
end run


-- GENERIC FUNCTIONS ----------------------------------------------------------


-- GENERIC ABSTRACTIONS ---------------------------------
-- enumFromTo :: Int -> Int -> [Int]

on enumFromTo(m, n)
-- center :: Int -> Char -> String -> String
if n < m then
on |center|(n, cFiller, strText)
set d to -1
set lngFill to n - (length of strText)
if lngFill > 0 then
set strPad to replicate(lngFill div 2, cFiller) as text
set strCenter to strPad & strText & strPad
if lngFill mod 2 > 0 then
cFiller & strCenter
else
strCenter
end if
else
else
set d to 1
strText
end if
end if
end |center|
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo


-- foldr :: (a -> b -> a) -> a -> [b] -> a
-- intercalate :: String -> [String] -> String
on foldr(f, startValue, xs)
on intercalate(sep, xs)
set {dlm, my text item delimiters} to {my text item delimiters, sep}
tell mReturn(f)
set v to startValue
set s to xs as text
set lng to length of xs
repeat with i from lng to 1 by -1
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldr

-- 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
set my text item delimiters to dlm
return strJoined
return s
end intercalate
end intercalate

-- iterate :: (a -> a) -> a -> Generator [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

-- 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 ^ 30 -- (simple proxy for non-finite)
end if
end |length|


-- map :: (a -> b) -> [a] -> [b]
-- map :: (a -> b) -> [a] -> [b]
Line 421: Line 414:


-- Lift 2nd class handler function into 1st class script wrapper
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
on mReturn(f)
if class of f is script then
if class of f is script then
Line 431: Line 424:
end if
end if
end mReturn
end mReturn

-- plus :: Num -> Num -> Num
on plus(a, b)
a + b
end plus

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if n < 1 then return out
set dbl to {a}
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate

-- 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 end of ys to xs's |λ|()
end repeat
return ys
else
missing value
end if
end take

-- unlines :: [String] -> String
on unlines(xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines

-- 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


-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
on zipWith(f, xs, ys)
set lng to min(length of xs, length of ys)
set lng to min(|length|(xs), |length|(ys))
if 1 > lng then return {}
set xs_ to take(lng, xs) -- Allow for non-finite
set ys_ to take(lng, ys) -- generators like cycle etc
set lst to {}
set lst to {}
tell mReturn(f)
tell mReturn(f)
repeat with i from 1 to lng
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, item i of ys)
set end of lst to |λ|(item i of xs_, item i of ys_)
end repeat
end repeat
return lst
return lst
Line 444: Line 506:
end zipWith</lang>
end zipWith</lang>
{{Out}}
{{Out}}
<pre> 1
<pre> 1
1 1
1 1
1 2 1
1 2 1
1 3 3 1
1 3 3 1
1 4 6 4 1
1 4 6 4 1
1 5 10 10 5 1
1 5 10 10 5 1
1 6 15 20 15 6 1</pre>
1 6 15 20 15 6 1</pre>


=={{header|AutoHotkey}}==
=={{header|AutoHotkey}}==