September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,103 @@
|
|||
-- SIERPINKSI TRIANGLE -------------------------------------------------------
|
||||
|
||||
-- sierpinski :: Int -> [String]
|
||||
on sierpinski(n)
|
||||
if n > 0 then
|
||||
set previous to sierpinski(n - 1)
|
||||
set padding to replicate(2 ^ (n - 1), space)
|
||||
|
||||
script alignedCentre
|
||||
on |λ|(s)
|
||||
concat(padding & s & padding)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
script adjacentDuplicates
|
||||
on |λ|(s)
|
||||
unwords(replicate(2, s))
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
-- Previous triangle block centered,
|
||||
-- and placed on 2 adjacent duplicates.
|
||||
map(alignedCentre, previous) & map(adjacentDuplicates, previous)
|
||||
else
|
||||
{"*"}
|
||||
end if
|
||||
end sierpinski
|
||||
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
on run
|
||||
unlines(sierpinski(4))
|
||||
end run
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- concat :: [[a]] -> [a] | [String] -> String
|
||||
on concat(xs)
|
||||
if length of xs > 0 and class of (item 1 of xs) is string then
|
||||
set acc to ""
|
||||
else
|
||||
set acc to {}
|
||||
end if
|
||||
repeat with i from 1 to length of xs
|
||||
set acc to acc & item i of xs
|
||||
end repeat
|
||||
acc
|
||||
end concat
|
||||
|
||||
-- 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
|
||||
return strJoined
|
||||
end intercalate
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, 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
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
-- 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
|
||||
|
||||
-- unlines, unwords :: [String] -> String
|
||||
on unlines(xs)
|
||||
intercalate(linefeed, xs)
|
||||
end unlines
|
||||
|
||||
on unwords(xs)
|
||||
intercalate(space, xs)
|
||||
end unwords
|
||||
|
|
@ -1,3 +1,5 @@
|
|||
-- SIERPINSKI TRIANGLE BY XOR / RULE 90 --------------------------------------
|
||||
|
||||
-- sierpinskiTriangle :: Int -> String
|
||||
on sierpinskiTriangle(intOrder)
|
||||
|
||||
|
|
@ -7,7 +9,7 @@ on sierpinskiTriangle(intOrder)
|
|||
|
||||
-- pascalModTwo :: Int -> [[String]]
|
||||
script pascalModTwo
|
||||
on lambda(intRows)
|
||||
on |λ|(intRows)
|
||||
|
||||
-- addRow [[Int]] -> [[Int]]
|
||||
script addRow
|
||||
|
|
@ -24,21 +26,25 @@ on sierpinskiTriangle(intOrder)
|
|||
|
||||
-- rule :: Character -> Character -> Character
|
||||
script rule
|
||||
on lambda(a, b)
|
||||
cond(a = b, space, "*")
|
||||
end lambda
|
||||
on |λ|(a, b)
|
||||
if a = b then
|
||||
space
|
||||
else
|
||||
"*"
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
zipWith(rule, {" "} & row, row & {" "})
|
||||
end nextRow
|
||||
|
||||
on lambda(xs)
|
||||
on |λ|(xs)
|
||||
xs & {nextRow(item -1 of xs)}
|
||||
end lambda
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldr(addRow, {{"*"}}, range(1, intRows - 1))
|
||||
end lambda
|
||||
foldr(addRow, {{"*"}}, enumFromTo(1, intRows - 1))
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
-- The centring foldr (fold right) below starts from the end of the list,
|
||||
|
|
@ -47,33 +53,45 @@ on sierpinskiTriangle(intOrder)
|
|||
-- Each preceding row has one more indent space than the row below it.
|
||||
|
||||
script centred
|
||||
on lambda(sofar, row)
|
||||
on |λ|(sofar, row)
|
||||
set strIndent to indent of sofar
|
||||
|
||||
{triangle:strIndent & intercalate(space, row) & linefeed & ¬
|
||||
triangle of sofar, indent:strIndent & space}
|
||||
end lambda
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
triangle of foldr(centred, {triangle:"", indent:""}, ¬
|
||||
pascalModTwo's lambda(intOrder ^ 2))
|
||||
pascalModTwo's |λ|(intOrder ^ 2))
|
||||
|
||||
end sierpinskiTriangle
|
||||
|
||||
|
||||
-- TEST
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
on run
|
||||
|
||||
set strTriangle to sierpinskiTriangle(4)
|
||||
|
||||
set the clipboard to strTriangle
|
||||
|
||||
strTriangle
|
||||
|
||||
end run
|
||||
|
||||
|
||||
-- GENERIC LIBRARY FUNCTIONS
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- enumFromTo :: Int -> Int -> [Int]
|
||||
on enumFromTo(m, n)
|
||||
if m > n then
|
||||
set d to -1
|
||||
else
|
||||
set d to 1
|
||||
end if
|
||||
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
|
||||
on foldr(f, startValue, xs)
|
||||
|
|
@ -81,7 +99,7 @@ on foldr(f, startValue, xs)
|
|||
set v to startValue
|
||||
set lng to length of xs
|
||||
repeat with i from lng to 1 by -1
|
||||
set v to lambda(v, item i of xs, i, xs)
|
||||
set v to |λ|(v, item i of xs, i, xs)
|
||||
end repeat
|
||||
return v
|
||||
end tell
|
||||
|
|
@ -95,6 +113,15 @@ on intercalate(strText, lstText)
|
|||
return strJoined
|
||||
end intercalate
|
||||
|
||||
-- min :: Ord a => a -> a -> a
|
||||
on min(x, y)
|
||||
if y < x then
|
||||
y
|
||||
else
|
||||
x
|
||||
end if
|
||||
end min
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
|
|
@ -102,48 +129,19 @@ on mReturn(f)
|
|||
f
|
||||
else
|
||||
script
|
||||
property lambda : f
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
-- range :: Int -> Int -> [Int]
|
||||
on range(m, n)
|
||||
if n < m then
|
||||
set d to -1
|
||||
else
|
||||
set d to 1
|
||||
end if
|
||||
set lst to {}
|
||||
repeat with i from m to n by d
|
||||
set end of lst to i
|
||||
end repeat
|
||||
return lst
|
||||
end range
|
||||
|
||||
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
|
||||
on zipWith(f, xs, ys)
|
||||
set nx to length of xs
|
||||
set ny to length of ys
|
||||
if nx < 1 or ny < 1 then
|
||||
{}
|
||||
else
|
||||
set lng to cond(nx < ny, nx, ny)
|
||||
set lst to {}
|
||||
tell mReturn(f)
|
||||
repeat with i from 1 to lng
|
||||
set end of lst to lambda(item i of xs, item i of ys)
|
||||
end repeat
|
||||
return lst
|
||||
end tell
|
||||
end if
|
||||
set lng to min(length of xs, length of ys)
|
||||
set lst to {}
|
||||
tell mReturn(f)
|
||||
repeat with i from 1 to lng
|
||||
set end of lst to |λ|(item i of xs, item i of ys)
|
||||
end repeat
|
||||
return lst
|
||||
end tell
|
||||
end zipWith
|
||||
|
||||
-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b)
|
||||
on cond(bool, f, g)
|
||||
if bool then
|
||||
f
|
||||
else
|
||||
g
|
||||
end if
|
||||
end cond
|
||||
Loading…
Add table
Add a link
Reference in a new issue