111 lines
2.5 KiB
AppleScript
111 lines
2.5 KiB
AppleScript
use framework "Foundation"
|
|
|
|
----------- INTEGER VALUE OF ROMAN NUMBER STRING ---------
|
|
|
|
-- fromRoman :: String -> Int
|
|
on fromRoman(s)
|
|
script subtractIfLower
|
|
on |λ|(l, rn)
|
|
set {r, n} to rn
|
|
if l ≥ r then -- Digit values that increase (L to R),
|
|
{l, n + l} -- (added)
|
|
else
|
|
{l, n - l} -- Digit values that go down: subtracted.
|
|
end if
|
|
end |λ|
|
|
end script
|
|
|
|
item 2 of foldr(subtractIfLower, {0, 0}, ¬
|
|
map(my charVal, characters of s))
|
|
end fromRoman
|
|
|
|
|
|
-- charVal :: Char -> Int
|
|
on charVal(C)
|
|
set v to lookup(toUpper(C), ¬
|
|
{I:1, |V|:5, X:10, |L|:50, C:100, D:500, M:1000})
|
|
if missing value is v then
|
|
0
|
|
else
|
|
v
|
|
end if
|
|
end charVal
|
|
|
|
|
|
--------------------------- TEST -------------------------
|
|
on run
|
|
map(fromRoman, ¬
|
|
{"MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXXI"})
|
|
|
|
--> {1666, 1990, 2008, 2016, 2021}
|
|
end run
|
|
|
|
|
|
-------------------- GENERIC FUNCTIONS -------------------
|
|
|
|
-- foldr :: (a -> b -> b) -> b -> [a] -> b
|
|
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 |λ|(item I of xs, v)
|
|
end repeat
|
|
return v
|
|
end tell
|
|
end foldr
|
|
|
|
|
|
-- lookup :: a -> Dict -> Maybe b
|
|
on lookup(k, dct)
|
|
-- Just the value of k in the dictionary,
|
|
-- or missing value if k is not found.
|
|
set ca to current application
|
|
set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s ¬
|
|
objectForKey:k
|
|
if missing value ≠ v then
|
|
item 1 of ((ca's NSArray's arrayWithObject:v) as list)
|
|
else
|
|
missing value
|
|
end if
|
|
end lookup
|
|
|
|
|
|
-- map :: (a -> b) -> [a] -> [b]
|
|
on map(f, xs)
|
|
-- The list obtained by applying f
|
|
-- to each element of 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
|
|
|
|
|
|
-- toUpper :: String -> String
|
|
on toUpper(str)
|
|
tell current application
|
|
((its (NSString's stringWithString:(str)))'s ¬
|
|
uppercaseStringWithLocale:¬
|
|
(its NSLocale's currentLocale())) as text
|
|
end tell
|
|
end toUpper
|