Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,175 @@
|
|||
------------- INTEGER VALUE OF A ROMAN STRING ------------
|
||||
|
||||
-- romanValue :: String -> Int
|
||||
on romanValue(s)
|
||||
script roman
|
||||
property mapping : [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ¬
|
||||
["C", 100], ["XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ¬
|
||||
["V", 5], ["IV", 4], ["I", 1]]
|
||||
|
||||
-- Value of first Roman glyph + value of remaining glyphs
|
||||
-- toArabic :: [Char] -> Int
|
||||
on toArabic(xs)
|
||||
-- transcribe :: (String, Number) -> Maybe (Number, [String])
|
||||
script transcribe
|
||||
on |λ|(pair)
|
||||
set {r, v} to pair
|
||||
if isPrefixOf(characters of r, xs) then
|
||||
|
||||
-- Value of this matching glyph, with any remaining glyphs
|
||||
{v, drop(length of r, xs)}
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
if 0 < length of xs then
|
||||
set parsed to concatMap(transcribe, mapping)
|
||||
(item 1 of parsed) + toArabic(item 2 of parsed)
|
||||
else
|
||||
0
|
||||
end if
|
||||
end toArabic
|
||||
end script
|
||||
|
||||
toArabic(characters of s) of roman
|
||||
end romanValue
|
||||
|
||||
--------------------------- TEST -------------------------
|
||||
on run
|
||||
map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
|
||||
|
||||
--> {1990, 1666, 2008}
|
||||
end run
|
||||
|
||||
|
||||
-------------------- GENERIC FUNCTIONS -------------------
|
||||
|
||||
-- concatMap :: (a -> [b]) -> [a] -> [b]
|
||||
on concatMap(f, xs)
|
||||
set lng to length of xs
|
||||
set acc to {}
|
||||
tell mReturn(f)
|
||||
repeat with i from 1 to lng
|
||||
set acc to acc & (|λ|(item i of xs, i, xs))
|
||||
end repeat
|
||||
end tell
|
||||
if {text, string} contains class of xs then
|
||||
acc as text
|
||||
else
|
||||
acc
|
||||
end if
|
||||
end concatMap
|
||||
|
||||
|
||||
-- drop :: Int -> [a] -> [a]
|
||||
-- drop :: Int -> String -> String
|
||||
on drop(n, xs)
|
||||
set c to class of xs
|
||||
if script is not c then
|
||||
if string is not c then
|
||||
if n < length of xs then
|
||||
items (1 + n) thru -1 of xs
|
||||
else
|
||||
{}
|
||||
end if
|
||||
else
|
||||
if n < length of xs then
|
||||
text (1 + n) thru -1 of xs
|
||||
else
|
||||
""
|
||||
end if
|
||||
end if
|
||||
else
|
||||
take(n, xs) -- consumed
|
||||
return xs
|
||||
end if
|
||||
end drop
|
||||
|
||||
|
||||
-- isPrefixOf :: [a] -> [a] -> Bool
|
||||
-- isPrefixOf :: String -> String -> Bool
|
||||
on isPrefixOf(xs, ys)
|
||||
-- isPrefixOf takes two lists or strings and returns
|
||||
-- true if and only if the first is a prefix of the second.
|
||||
script go
|
||||
on |λ|(xs, ys)
|
||||
set intX to length of xs
|
||||
if intX < 1 then
|
||||
true
|
||||
else if intX > length of ys then
|
||||
false
|
||||
else if class of xs is string then
|
||||
(offset of xs in ys) = 1
|
||||
else
|
||||
set {xxt, yyt} to {uncons(xs), uncons(ys)}
|
||||
((item 1 of xxt) = (item 1 of yyt)) and ¬
|
||||
|λ|(item 2 of xxt, item 2 of yyt)
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
go's |λ|(xs, ys)
|
||||
end isPrefixOf
|
||||
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on |length|(xs)
|
||||
set c to class of xs
|
||||
if list is c or string is c then
|
||||
length of xs
|
||||
else
|
||||
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
|
||||
end if
|
||||
end |length|
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- uncons :: [a] -> Maybe (a, [a])
|
||||
on uncons(xs)
|
||||
set lng to |length|(xs)
|
||||
if 0 = lng then
|
||||
missing value
|
||||
else
|
||||
if (2 ^ 29 - 1) as integer > lng then
|
||||
if class of xs is string then
|
||||
set cs to text items of xs
|
||||
{item 1 of cs, rest of cs}
|
||||
else
|
||||
{item 1 of xs, rest of xs}
|
||||
end if
|
||||
else
|
||||
set nxt to take(1, xs)
|
||||
if {} is nxt then
|
||||
missing value
|
||||
else
|
||||
{item 1 of nxt, xs}
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end uncons
|
||||
|
|
@ -0,0 +1 @@
|
|||
{1990, 1666, 2008}
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
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
|
||||
|
|
@ -0,0 +1 @@
|
|||
{1666, 1990, 2008, 2016, 2021}
|
||||
Loading…
Add table
Add a link
Reference in a new issue