September 2017 Update

Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript

@@ -1,9 +1,3 @@
-on run
-    map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
-
-    --> {1990, 1666, 2008}
-end run
-
 -- romanValue :: String -> Int
 on romanValue(s)
     script roman
@@ -18,7 +12,7 @@ on romanValue(s)
                 -- If this glyph:value pair matches the head of the list
                 -- return the value and the tail of the list
                 -- transcribe :: (String, Number) -> Maybe (Number, [String])
-                on lambda(lstPair)
+                on |λ|(lstPair)
                     set lstR to characters of (item 1 of lstPair)
                     if isPrefixOf(lstR, xs) then
                         -- Value of this matching glyph, with any remaining glyphs
@@ -26,7 +20,7 @@ on romanValue(s)
                     else
                         {}
                     end if
-                end lambda
+                end |λ|
             end script
 
             if length of xs > 0 then
@@ -41,8 +35,40 @@ on romanValue(s)
     toArabic(characters of s) of roman
 end romanValue
 
+-- TEST -----------------------------------------------------------------------
+on run
+    map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
 
--- GENERIC LIBRARY FUNCTIONS
+    --> {1990, 1666, 2008}
+end run
+
+
+-- GENERIC FUNCTIONS ----------------------------------------------------------
+
+-- concatMap :: (a -> [b]) -> [a] -> [b]
+on concatMap(f, xs)
+    set lst to {}
+    set lng to length of xs
+    tell mReturn(f)
+        repeat with i from 1 to lng
+            set lst to (lst & |λ|(item i of xs, i, xs))
+        end repeat
+    end tell
+    return lst
+end concatMap
+
+--  drop :: Int -> a -> a
+on drop(n, a)
+    if n < length of a then
+        if class of a is text then
+            text (n + 1) thru -1 of a
+        else
+            items (n + 1) thru -1 of a
+        end if
+    else
+        {}
+    end if
+end drop
 
 -- isPrefixOf :: [a] -> [a] -> Bool
 on isPrefixOf(xs, ys)
@@ -59,54 +85,30 @@ on isPrefixOf(xs, ys)
     end if
 end isPrefixOf
 
---  drop :: Int -> a -> a
-on drop(n, a)
-    if n < length of a then
-        if class of a is text then
-            text (n + 1) thru -1 of a
-        else
-            items (n + 1) thru -1 of a
-        end if
-    else
-        {}
-    end if
-end drop
-
--- concatMap :: (a -> [b]) -> [a] -> [b]
-on concatMap(f, xs)
-    script append
-        on lambda(a, b)
-            a & b
-        end lambda
-    end script
-
-    foldl(append, {}, map(f, xs))
-end concatMap
-
--- 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)
+            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
+
 -- uncons :: [a] -> Maybe (a, [a])
 on uncons(xs)
     if length of xs > 0 then
@@ -115,15 +117,3 @@ on uncons(xs)
         missing value
     end if
 end uncons
-
--- 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

Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-3.applescript

@@ -0,0 +1,103 @@
+use framework "Foundation"
+
+-- INTEGER VALUE OF ROMAN NUMBER STRING ---------------------------------------
+
+-- fromRoman :: String -> Int
+on fromRoman(s)
+    script subtractIfLower
+        on |λ|(rn, L)
+            set {r, n} to rn
+            if L ≥ r then  -- Digit values that increase (right to left),
+                {L, n + L} -- are added
+            else
+                {L, n - L} -- Digit values that go down, are subtracted.
+            end if
+        end |λ|
+    end script
+
+    snd(foldr(subtractIfLower, {0, 0}, map(my charVal, characters of s)))
+end fromRoman
+
+-- charVal :: Char -> Int
+on charVal(C)
+    set V to keyValue({I:1, V:5, X:10, L:50, C:100, D:500, M:1000}, ¬
+        toUpper(C))
+    if nothing of V then
+        0
+    else
+        just of V
+    end if
+end charVal
+
+-- TEST -----------------------------------------------------------------------
+on run
+    map(fromRoman, {"MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"})
+
+    --> {1666, 1990, 2008, 2016, 2017}
+end run
+
+
+-- GENERIC FUNCTIONS ----------------------------------------------------------
+
+-- foldr :: (a -> b -> a) -> a -> [b] -> a
+on foldr(f, startValue, xs)
+    tell mReturn(f)
+        set V to startValue
+        set lng to length of xs
+        repeat with I from lng to 1 by -1
+            set V to |λ|(V, item I of xs, I, xs)
+        end repeat
+        return V
+    end tell
+end foldr
+
+-- keyValue :: Record -> String -> Maybe String
+on keyValue(rec, strKey)
+    set ca to current application
+    set V to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey
+    if V is not missing value then
+        {nothing:false, just:item 1 of ((ca's NSArray's arrayWithObject:V) as list)}
+    else
+        {nothing:true}
+    end if
+end keyValue
+
+-- 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
+
+-- snd :: (a, b) -> b
+on snd(xs)
+    if class of xs is list and length of xs = 2 then
+        item 2 of xs
+    else
+        missing value
+    end if
+end snd
+
+-- toUpper :: String -> String
+on toUpper(str)
+    set ca to current application
+    ((ca's NSString's stringWithString:(str))'s ¬
+        uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
+end toUpper

Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-4.applescript

@@ -0,0 +1 @@
+{1666, 1990, 2008, 2016, 2017}