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 pascal() |
|||
script nextRow |
|||
on |λ|(row) |
|||
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 |
||
showPascal(take(7, pascal())) |
|||
end run |
|||
script spaced |
|||
on |λ|(xs) |
|||
-- showPascal :: [[Int]] -> String |
|||
script rightAlign |
|||
on showPascal(xs) |
|||
on |λ|(x) |
|||
set w to length of intercalate(" ", item -1 of xs) |
|||
script align |
|||
end |λ| |
|||
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 |
||
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 |
|||
-- |
-- intercalate :: String -> [String] -> String |
||
on |
on intercalate(sep, xs) |
||
set {dlm, my text item delimiters} to {my text item delimiters, sep} |
|||
tell mReturn(f) |
|||
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 |
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 :: |
-- 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 |
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 |
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> |
<pre> 1 |
||
1 1 |
|||
1 |
1 2 1 |
||
1 3 3 1 |
|||
1 4 6 4 1 |
|||
1 5 10 10 5 1 |
|||
1 6 15 20 15 6 1</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |