September 2017 Update

Task/Range-extraction/AppleScript/range-extraction.applescript

@@ -1,111 +1,94 @@
-on run
-
-    rangeString([0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, ¬
-        16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, ¬
-        28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39])
-
-end run
-
--- rangeString :: [Int] -> String
-on rangeString(xs)
-    script addNumberOrRange
-        property iLast : length of xs
-
-        -- [[Int]] -> Int -> Int -> [Int] -> [[Int]]
-        on lambda(lstAccumulator, x, iPosn, xs)
-            if iPosn < iLast then
-                if ((item (iPosn + 1) of xs) - x) > 1 then -- rightward gap > 1
-                    [[x]] & lstAccumulator --> start of new series
-                else
-                    -- Prepended to current series
-                    -- (if a series-breaker, or start list, is at left)
-                    if ((iPosn = 1) or (x - (item (iPosn - 1) of xs)) > 1) then
-                        [[x] & (item 1 of lstAccumulator)] & tail(lstAccumulator)
-                    else
-                        lstAccumulator -- Stet - series continues
-                    end if
-                end if
+-- rangeFormat :: [Int] -> String
+on rangeFormat(xs)
+    script rangeString
+        on |λ|(xs)
+            if length of xs > 2 then
+                (item 1 of xs as string) & "-" & (item -1 of xs as string)
             else
-                [[x]]
+                intercalate(",", xs)
             end if
-        end lambda
+        end |λ|
     end script
 
-    interCalate(",", ¬
-        map(my delimitedString, ¬
-            foldr(addNumberOrRange, [], xs)))
-end rangeString
+    script nonConsec
+        on |λ|(a, b)
+            b - a > 1
+        end |λ|
+    end script
+
+    intercalate(",", map(rangeString, splitBy(nonConsec, xs)))
+end rangeFormat
 
 
--- delimitedString :: [Int] -> String
-on delimitedString(lstInt)
-    set intFirst to item 1 of lstInt
+--TEST ------------------------------------------------------------------------
+on run
+    set xs to {0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, ¬
+        17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, ¬
+        33, 35, 36, 37, 38, 39}
 
-    if length of lstInt > 1 then
-        set intSecond to item 2 of lstInt
-        set delta to intSecond - intFirst
+    rangeFormat(xs)
+
+    --> "0-2,4,6-8,11,12,14-25,27-33,35-39"
+end run
+
+
+-- GENERIC FUNCTIONS ----------------------------------------------------------
+
+-- splitBy :: (a -> a -> Bool) -> [a] -> [[a]]
+on splitBy(f, xs)
+    set mf to mReturn(f)
+
+    if length of xs < 2 then
+        {xs}
     else
-        set delta to 0
+        script p
+            on |λ|(a, x)
+                set {acc, active, prev} to a
+                if mf's |λ|(prev, x) then
+                    {acc & {active}, {x}, x}
+                else
+                    {acc, active & x, x}
+                end if
+            end |λ|
+        end script
+
+        set h to item 1 of xs
+        set lstParts to foldl(p, {{}, {h}, h}, items 2 thru -1 of xs)
+        item 1 of lstParts & {item 2 of lstParts}
     end if
+end splitBy
 
-    if delta > 0 then
-        (intFirst as string) & cond(delta > 1, "-", ",") & intSecond as string
-    else
-        intFirst as string
-    end if
-end delimitedString
+-- 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
 
-
--- GENERIC LIBRARY FUNCTIONS
+-- 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
 
 -- intercalate :: Text -> [Text] -> Text
-on interCalate(strText, lstText)
+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
-
--- foldr :: (a -> b -> a) -> a -> [b] -> a
-on foldr(f, startValue, xs)
-    set mf to mReturn(f)
-
-    set v to startValue
-    set lng to length of xs
-    repeat with i from lng to 1 by -1
-        set v to mf's lambda(v, item i of xs, i, xs)
-    end repeat
-    return v
-end foldr
-
--- map :: (a -> b) -> [a] -> [b]
-on map(f, xs)
-    set mf to mReturn(f)
-    set lng to length of xs
-    set lst to {}
-    repeat with i from 1 to lng
-        set end of lst to mf's lambda(item i of xs, i, xs)
-    end repeat
-    return lst
-end map
-
--- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b)
-on cond(bool, f, g)
-    if bool then
-        f
-    else
-        g
-    end if
-end cond
-
--- tail :: [a] -> [a]
-on tail(xs)
-    if class of xs is list and length of xs > 1 then
-        items 2 thru -1 of xs
-    else
-        {}
-    end if
-end tail
+end intercalate
 
 -- Lift 2nd class handler function into 1st class script wrapper
 -- mReturn :: Handler -> Script
@@ -114,7 +97,7 @@ on mReturn(f)
         f
     else
         script
-            property lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn