use AppleScript version "2.4" use framework "Foundation" use scripting additions on run unlines(map(¬ compose(compose(unlines, sparkLine), readFloats), ¬ {"0, 1, 19, 20", "0, 999, 4000, 4999, 7000, 7999", ¬ "0, 1000, 4000, 5000, 7000, 8000", ¬ "1 2 3 4 5 6 7 8 7 6 5 4 3 2 1", ¬ "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5"})) end run -- sparkLine :: [Float] -> [String] on sparkLine(xs) set ys to sort(xs) set mn to item 1 of ys set mx to item -1 of ys set n to length of xs set mid to (n div 2) set w to (mx - mn) / 8 script bound on |λ|(x) mn + (w * x) end |λ| end script set lbounds to map(bound, enumFromTo(1, 7)) script spark on |λ|(x) script flipGT on |λ|(b) b > x end |λ| end script script indexedBlock on |λ|(i) item i of "▁▂▃▄▅▆▇" end |λ| end script maybe("█", indexedBlock, findIndex(flipGT, lbounds)) end |λ| end script script str on |λ|(x) x as string end |λ| end script {concat(map(spark, xs)), ¬ unwords(map(str, xs)), ¬ "Min " & mn as string, ¬ "Mean " & roundTo(mean(xs), 2) as string, ¬ "Median " & bool(item mid of xs, ((item mid of xs) + ¬ (item (mid + 1) of xs)) / 2, even(n)), ¬ "Max " & mx as string, ""} end sparkLine -- GENERIC ------------------------------------------------- -- Just :: a -> Maybe a on Just(x) {type:"Maybe", Nothing:false, Just:x} end Just -- Nothing :: Maybe a on Nothing() {type:"Maybe", Nothing:true} end Nothing -- bool :: a -> a -> Bool -> a on bool(f, t, p) if p then t else f end if end bool -- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c on compose(f, g) script property mf : mReturn(f) property mg : mReturn(g) on |λ|(x) mf's |λ|(mg's |λ|(x)) end |λ| end script end compose -- concat :: [[a]] -> [a] -- concat :: [String] -> String on concat(xs) set lng to length of xs if 0 < lng and string is class of (item 1 of xs) then set acc to "" else set acc to {} end if repeat with i from 1 to lng set acc to acc & item i of xs end repeat acc end concat -- 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 -- even :: Int -> Bool on even(x) 0 = x mod 2 end even -- Takes a predicate function and a list and -- returns Just( the 1-based index of the first -- element ) in the list satisfying the predicate -- or Nothing if there is no such element. -- findIndex(isSpace, "hello world") --> {type:"Maybe", Nothing:false, Just:6} -- findIndex(even, [3, 5, 7, 8, 9]) --> {type:"Maybe", Nothing:false, Just:4} -- findIndex(isUpper, "all lower case") --> {type:"Maybe", Nothing:true} -- findIndex :: (a -> Bool) -> [a] -> Maybe Int on findIndex(p, xs) tell mReturn(p) set lng to length of xs repeat with i from 1 to lng if |λ|(item i of xs) then return Just(i) end repeat return Nothing() end tell end findIndex -- 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 -- 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 -- mean :: [Num] -> Num on mean(xs) script on |λ|(a, x) a + x end |λ| end script foldl(result, 0, xs) / (length of xs) end mean -- | The 'maybe' function takes a default value, a function, and a 'Maybe' -- value. If the 'Maybe' value is 'Nothing', the function returns the -- default value. Otherwise, it applies the function to the value inside -- the 'Just' and returns the result. -- maybe :: b -> (a -> b) -> Maybe a -> b on maybe(v, f, mb) if Nothing of mb then v else tell mReturn(f) to |λ|(Just of mb) end if end maybe -- Lift 2nd class handler function into 1s class script wrapper -- mReturn :: First-class m => (a -> b) -> m (a -> b) on mReturn(f) if script is class of f then f else script property |λ| : f end script end if end mReturn -- readFloats :: String -> [Float] on readFloats(s) script asReal on |λ|(n) n as real end |λ| end script map(asReal, splitRegex("[\\s,]+", s)) end readFloats -- regexMatches :: String -> String -> [[String]] on regexMatches(strRegex, strHay) set ca to current application -- NSNotFound handling and and High Sierra workaround due to @sl1974 set NSNotFound to a reference to 9.22337203685477E+18 + 5807 set oRgx to ca's NSRegularExpression's regularExpressionWithPattern:strRegex ¬ options:((ca's NSRegularExpressionAnchorsMatchLines as integer)) ¬ |error|:(missing value) set oString to ca's NSString's stringWithString:strHay script matchString on |λ|(m) script rangeMatched on |λ|(i) tell (m's rangeAtIndex:i) set intFrom to its location if NSNotFound ≠ intFrom then text (intFrom + 1) thru (intFrom + (its |length|)) of strHay else missing value end if end tell end |λ| end script end |λ| end script script asRange on |λ|(x) range() of x end |λ| end script map(asRange, (oRgx's matchesInString:oString ¬ options:0 range:{location:0, |length|:oString's |length|()}) as list) end regexMatches -- roundTo :: Float -> Int -> Float on roundTo(x, n) set d to 10 ^ n (round (x * d)) / d end roundTo -- sort :: Ord a => [a] -> [a] on sort(xs) ((current application's NSArray's arrayWithArray:xs)'s ¬ sortedArrayUsingSelector:"compare:") as list end sort -- splitRegex :: Regex -> String -> [String] on splitRegex(strRegex, str) set lstMatches to regexMatches(strRegex, str) if length of lstMatches > 0 then script preceding on |λ|(a, x) set iFrom to start of a set iLocn to (location of x) if iLocn > iFrom then set strPart to text (iFrom + 1) thru iLocn of str else set strPart to "" end if {parts:parts of a & strPart, start:iLocn + (length of x) - 1} end |λ| end script set recLast to foldl(preceding, {parts:[], start:0}, lstMatches) set iFinal to start of recLast if iFinal < length of str then parts of recLast & text (iFinal + 1) thru -1 of str else parts of recLast & "" end if else {str} end if end splitRegex -- 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