2016 Update

Task/Align-columns/AppleScript/align-columns.applescript

@@ -0,0 +1,216 @@
+property pstrLines : ¬
+    "Given$a$text$file$of$many$lines,$where$fields$within$a$line$\n" & ¬
+    "are$delineated$by$a$single$'dollar'$character,$write$a$program\n" & ¬
+    "that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$\n" & ¬
+    "column$are$separated$by$at$least$one$space.\n" & ¬
+    "Further,$allow$for$each$word$in$a$column$to$be$either$left$\n" & ¬
+    "justified,$right$justified,$or$center$justified$within$its$column."
+
+property eLeft : -1
+property eCenter : 0
+property eRight : 1
+
+on run
+    set lstCols to lineColumns("$", pstrLines)
+
+    script testAlignment
+        on lambda(eAlign)
+            columnsAligned(eAlign, lstCols)
+        end lambda
+    end script
+
+    intercalate(return & return, ¬
+        map(testAlignment, {eLeft, eRight, eCenter}))
+end run
+
+
+-- columnsAligned :: EnumValue -> [[String]] -> String
+on columnsAligned(eAlign, lstCols)
+    -- padwords :: Int -> [String] -> [[String]]
+    script padwords
+        on lambda(n, lstWords)
+
+            -- pad :: String -> String
+            script pad
+                on lambda(str)
+                    set lngPad to n - (length of str)
+                    if eAlign = my eCenter then
+                        set lngHalf to lngPad div 2
+                        {replicate(lngHalf, space), str, ¬
+                            replicate(lngPad - lngHalf, space)}
+                    else
+                        if eAlign = my eLeft then
+                            {"", str, replicate(lngPad, space)}
+                        else
+                            {replicate(lngPad, space), str, ""}
+                        end if
+                    end if
+                end lambda
+            end script
+
+            map(pad, lstWords)
+        end lambda
+    end script
+
+    unlines(map(my unwords, ¬
+        transpose(zipWith(padwords, ¬
+            map(my widest, lstCols), lstCols))))
+end columnsAligned
+
+-- lineColumns :: String -> String -> String
+on lineColumns(strColDelim, strText)
+    -- _words :: Text -> [Text]
+    script _words
+        on lambda(str)
+            splitOn(strColDelim, str)
+        end lambda
+    end script
+
+    set lstRows to map(_words, splitOn(linefeed, pstrLines))
+    set nCols to widest(lstRows)
+
+    -- fullRow :: [[a]] -> [[a]]
+    script fullRow
+        on lambda(lst)
+            lst & replicate(nCols - (length of lst), {""})
+        end lambda
+    end script
+
+    transpose(map(fullRow, lstRows))
+end lineColumns
+
+-- widest [a] -> Int
+on widest(xs)
+    script maxLen
+        on lambda(a, x)
+            set lng to length of x
+            cond(lng > a, lng, a)
+        end lambda
+    end script
+
+    foldl(maxLen, 0, xs)
+end widest
+
+
+
+-- GENERIC LIBRARY FUNCTIONS
+
+-- 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
+
+-- Text -> Text -> [Text]
+on splitOn(strDelim, strMain)
+    set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
+    set lstParts to text items of strMain
+    set my text item delimiters to dlm
+    return lstParts
+end splitOn
+
+-- [Text] -> Text
+on unlines(lstLines)
+    intercalate(linefeed, lstLines)
+end unlines
+
+-- [Text] -> Text
+on unwords(lstWords)
+    intercalate(" ", lstWords)
+end unwords
+
+-- transpose :: [[a]] -> [[a]]
+on transpose(xss)
+    script column
+        on lambda(_, iCol)
+            script row
+                on lambda(xs)
+                    item iCol of xs
+                end lambda
+            end script
+
+            map(row, xss)
+        end lambda
+    end script
+
+    map(column, item 1 of xss)
+end transpose
+
+-- 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 lambda(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldl
+
+-- 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 lambda(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+on zipWith(f, xs, ys)
+    set lng to length of xs
+    if lng is not length of ys then return missing value
+
+    tell mReturn(f)
+        set lst to {}
+        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 zipWith
+
+-- cond :: Bool -> a -> a -> a
+on cond(bool, f, g)
+    if bool then
+        f
+    else
+        g
+    end if
+end cond
+
+-- 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 cond(class of a is string, "", {})
+    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
+
+-- 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 lambda : f
+        end script
+    end if
+end mReturn