YAPC::EU 2018 Glasgow Update!

Task/Spiral-matrix/AppleScript/spiral-matrix.applescript

@@ -1,83 +1,167 @@
--- SPIRAL MATRIX -------------------------------------------------------------
+-- spiral :: Int -> [[Int]]
+on spiral(n)
+    script go
+        on |λ|(rows, cols, start)
+            if 0 < rows then
+                {enumFromTo(start, start + pred(cols))} & ¬
+                    map(my |reverse|, ¬
+                        (transpose(|λ|(cols, pred(rows), start + cols))))
+            else
+                {{}}
+            end if
+        end |λ|
+    end script
 
--- spiral :: Int -> Int -> Int -> [[Int]]
-on spiral(lngRows, lngCols, nStart)
-    if lngRows > 0 then
-        {enumFromTo(nStart, (nStart + lngCols) - 1)} & ¬
-            map(my |reverse|, ¬
-                transpose(spiral(lngCols, lngRows - 1, nStart + lngCols)))
-    else
-        {{}}
-    end if
+    go's |λ|(n, n, 0)
 end spiral
 
-
--- TEST ----------------------------------------------------------------------
+-- TEST ------------------------------------------------------------------
 on run
-    set n to 5
-    set lstSpiral to spiral(n, n, 0)
 
-    -- {{0, 1, 2, 3, 4}, {15, 16, 17, 18, 5}, {14, 23, 24, 19, 6},
-    --  {13, 22, 21, 20, 7}, {12, 11, 10, 9, 8}}
-
-    wikiTable(lstSpiral, ¬
+    wikiTable(spiral(5), ¬
         false, ¬
         "text-align:center;width:12em;height:12em;table-layout:fixed;")
 end run
 
-
 -- WIKI TABLE FORMAT ---------------------------------------------------------
 
 -- wikiTable :: [Text] -> Bool -> Text -> Text
 on wikiTable(lstRows, blnHdr, strStyle)
     script fWikiRows
         on |λ|(lstRow, iRow)
-            set strDelim to cond(blnHdr and (iRow = 0), "!", "|")
+            set strDelim to if_(blnHdr and (iRow = 0), "!", "|")
             set strDbl to strDelim & strDelim
             linefeed & "|-" & linefeed & strDelim & space & ¬
-                intercalate(space & strDbl & space, lstRow)
+                intercalateS(space & strDbl & space, lstRow)
         end |λ|
     end script
 
     linefeed & "{| class=\"wikitable\" " & ¬
-        cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
-        intercalate("", ¬
+        if_(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
+        intercalateS("", ¬
             map(fWikiRows, lstRows)) & linefeed & "|}" & linefeed
 end wikiTable
 
+-- GENERIC ------------------------------------------------------------------
 
--- GENERIC FUNCTIONS ---------------------------------------------------------
+-- comparing :: (a -> b) -> (a -> a -> Ordering)
+on comparing(f)
+    script
+        on |λ|(a, b)
+            tell mReturn(f)
+                set fa to |λ|(a)
+                set fb to |λ|(b)
+                if fa < fb then
+                    -1
+                else if fa > fb then
+                    1
+                else
+                    0
+                end if
+            end tell
+        end |λ|
+    end script
+end comparing
 
--- cond :: Bool -> a -> a -> a
-on cond(bool, x, y)
+-- concatMap :: (a -> [b]) -> [a] -> [b]
+on concatMap(f, xs)
+    set lng to length of xs
+    if 0 < lng and class of xs is string then
+        set acc to ""
+    else
+        set acc to {}
+    end if
+    tell mReturn(f)
+        repeat with i from 1 to lng
+            set acc to acc & |λ|(item i of xs, i, xs)
+        end repeat
+    end tell
+    return acc
+end concatMap
+
+-- enumFromTo :: Int -> Int -> [Int]
+on enumFromTo(m, n)
+    if m ≤ n then
+        set lst to {}
+        repeat with i from m to n
+            set end of lst to i
+        end repeat
+        return lst
+    else
+        return {}
+    end if
+end enumFromTo
+
+-- foldl :: (a -> b -> a) -> a -> [b] -> a
+on foldl(f, startValue, xs)
+    tell mReturn(f)
+        set v to startValue
+        set lng to length of xs
+        repeat with i from 1 to lng
+            set v to |λ|(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldl
+
+-- if_ :: Bool -> a -> a -> a
+on if_(bool, x, y)
     if bool then
         x
     else
         y
     end if
-end cond
+end if_
 
--- 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
-
--- 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
+-- intercalateS :: String -> [String] -> String
+on intercalateS(sep, xs)
+    set {dlm, my text item delimiters} to {my text item delimiters, sep}
+    set s to xs as text
     set my text item delimiters to dlm
-    return strJoined
-end intercalate
+    return s
+end intercalateS
+
+-- length :: [a] -> Int
+on |length|(xs)
+    length of xs
+end |length|
+
+-- max :: Ord a => a -> a -> a
+on max(x, y)
+    if x > y then
+        x
+    else
+        y
+    end if
+end max
+
+-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
+on maximumBy(f, xs)
+    set cmp to mReturn(f)
+    script max
+        on |λ|(a, b)
+            if a is missing value or cmp's |λ|(a, b) < 0 then
+                b
+            else
+                a
+            end if
+        end |λ|
+    end script
+
+    foldl(max, missing value, xs)
+end maximumBy
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
 
 -- map :: (a -> b) -> [a] -> [b]
 on map(f, xs)
@@ -91,17 +175,28 @@ on map(f, xs)
     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
+-- pred :: Enum a => a -> a
+on pred(x)
+    (-1) + x
+end pred
+
+-- 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
+
 
 -- reverse :: [a] -> [a]
 on |reverse|(xs)
@@ -112,19 +207,48 @@ on |reverse|(xs)
     end if
 end |reverse|
 
+-- If some of the rows are shorter than the following rows,
+-- their elements are skipped:
+-- transpose({{10,11},{20},{},{30,31,32}}) -> {{10, 20, 30}, {11, 31}, {32}}
 -- transpose :: [[a]] -> [[a]]
-on transpose(xss)
-    script column
-        on |λ|(_, iCol)
-            script row
-                on |λ|(xs)
-                    item iCol of xs
-                end |λ|
-            end script
-
-            map(row, xss)
+on transpose(xxs)
+    set intMax to |length|(maximumBy(comparing(my |length|), xxs))
+    set gaps to replicate(intMax, {})
+    script padded
+        on |λ|(xs)
+            set lng to |length|(xs)
+            if lng < intMax then
+                xs & items (lng + 1) thru -1 of gaps
+            else
+                xs
+            end if
         end |λ|
     end script
+    set rows to map(padded, xxs)
 
-    map(column, item 1 of xss)
+    script cols
+        on |λ|(_, iCol)
+            script cell
+                on |λ|(row)
+                    item iCol of row
+                end |λ|
+            end script
+            concatMap(cell, rows)
+        end |λ|
+    end script
+    map(cols, item 1 of rows)
 end transpose
+
+-- 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)
+    intercalateS(space, xs)
+end unwords