September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
28
Task/ABC-Problem/AppleScript/abc-problem-1.applescript
Normal file
28
Task/ABC-Problem/AppleScript/abc-problem-1.applescript
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
set blocks to {"bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs", ¬
|
||||
"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}
|
||||
|
||||
canMakeWordWithBlocks("a", blocks)
|
||||
canMakeWordWithBlocks("bark", blocks)
|
||||
canMakeWordWithBlocks("book", blocks)
|
||||
canMakeWordWithBlocks("treat", blocks)
|
||||
canMakeWordWithBlocks("common", blocks)
|
||||
canMakeWordWithBlocks("squad", blocks)
|
||||
canMakeWordWithBlocks("confuse", blocks)
|
||||
|
||||
on canMakeWordWithBlocks(theString, constBlocks)
|
||||
copy constBlocks to theBlocks
|
||||
if theString = "" then return true
|
||||
set i to 1
|
||||
repeat
|
||||
if i > (count theBlocks) then exit repeat
|
||||
if character 1 of theString is in item i of theBlocks then
|
||||
set item i of theBlocks to missing value
|
||||
set theBlocks to strings of theBlocks
|
||||
if canMakeWordWithBlocks(rest of characters of theString as string, theBlocks) then
|
||||
return true
|
||||
end if
|
||||
end if
|
||||
set i to i + 1
|
||||
end repeat
|
||||
return false
|
||||
end canMakeWordWithBlocks
|
||||
242
Task/ABC-Problem/AppleScript/abc-problem-2.applescript
Normal file
242
Task/ABC-Problem/AppleScript/abc-problem-2.applescript
Normal file
|
|
@ -0,0 +1,242 @@
|
|||
use framework "Foundation"
|
||||
|
||||
-- SPELLING BY BLOCK ----------------------------------------------------------
|
||||
on run
|
||||
set blocks to map(chars, ¬
|
||||
|words|("BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"))
|
||||
|
||||
script blockSpelled
|
||||
on |λ|(s)
|
||||
intercalate(" -> ", ¬
|
||||
ap({my |quote|, compose({my |not|, my |null|, ¬
|
||||
curry(my spellWith)'s |λ|(blocks), my toUpper})}, {s}))
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
unlines(map(blockSpelled, ¬
|
||||
{"", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"}))
|
||||
end run
|
||||
|
||||
-- spellWith :: [(Char, Char)] -> String -> [[(Char, Char)]]
|
||||
on spellWith(blocks, ccs)
|
||||
if |null|(ccs) then
|
||||
{{}}
|
||||
else
|
||||
set {c, cs} to uncons(ccs)
|
||||
|
||||
script matchSequence
|
||||
on |λ|(pair)
|
||||
if elem(c, pair) then
|
||||
|
||||
script pairUsed
|
||||
on |λ|(xs)
|
||||
{{pair} & xs}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
concatMap(pairUsed, spellWith(|delete|(pair, blocks), cs))
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
concatMap(matchSequence, blocks)
|
||||
end if
|
||||
end spellWith
|
||||
|
||||
|
||||
-- GENERIC FUNCTIONS ----------------------------------------------------------
|
||||
|
||||
-- A list of functions applied to a list of arguments
|
||||
-- (<*> | ap) :: [(a -> b)] -> [a] -> [b]
|
||||
on ap(fs, xs)
|
||||
set lngFs to length of fs
|
||||
set lngXs to length of xs
|
||||
set lst to {}
|
||||
repeat with i from 1 to lngFs
|
||||
tell mReturn(item i of fs)
|
||||
repeat with j from 1 to lngXs
|
||||
set end of lst to |λ|(contents of (item j of xs))
|
||||
end repeat
|
||||
end tell
|
||||
end repeat
|
||||
return lst
|
||||
end ap
|
||||
|
||||
-- chars :: String -> [Char]
|
||||
on chars(s)
|
||||
characters of s
|
||||
end chars
|
||||
|
||||
-- compose :: [(a -> a)] -> (a -> a)
|
||||
on compose(fs)
|
||||
script
|
||||
on |λ|(x)
|
||||
script
|
||||
on |λ|(a, f)
|
||||
mReturn(f)'s |λ|(a)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldr(result, x, fs)
|
||||
end |λ|
|
||||
end script
|
||||
end compose
|
||||
|
||||
-- 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 & |λ|(contents of item i of xs, i, xs))
|
||||
end repeat
|
||||
end tell
|
||||
return lst
|
||||
end concatMap
|
||||
|
||||
-- curry :: (Script|Handler) -> Script
|
||||
on curry(f)
|
||||
script
|
||||
on |λ|(a)
|
||||
script
|
||||
on |λ|(b)
|
||||
|λ|(a, b) of mReturn(f)
|
||||
end |λ|
|
||||
end script
|
||||
end |λ|
|
||||
end script
|
||||
end curry
|
||||
|
||||
-- delete :: Eq a => a -> [a] -> [a]
|
||||
on |delete|(x, xs)
|
||||
set mbIndex to elemIndex(x, xs)
|
||||
set lng to length of xs
|
||||
|
||||
if mbIndex is not missing value then
|
||||
if lng > 1 then
|
||||
if mbIndex = 1 then
|
||||
items 2 thru -1 of xs
|
||||
else if mbIndex = lng then
|
||||
items 1 thru -2 of xs
|
||||
else
|
||||
tell xs to items 1 thru (mbIndex - 1) & ¬
|
||||
items (mbIndex + 1) thru -1
|
||||
end if
|
||||
else
|
||||
{}
|
||||
end if
|
||||
else
|
||||
xs
|
||||
end if
|
||||
end |delete|
|
||||
|
||||
-- elem :: Eq a => a -> [a] -> Bool
|
||||
on elem(x, xs)
|
||||
xs contains x
|
||||
end elem
|
||||
|
||||
-- elemIndex :: a -> [a] -> Maybe Int
|
||||
on elemIndex(x, xs)
|
||||
set lng to length of xs
|
||||
repeat with i from 1 to lng
|
||||
if x = (item i of xs) then return i
|
||||
end repeat
|
||||
return missing value
|
||||
end elemIndex
|
||||
|
||||
-- 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
|
||||
|
||||
-- intercalate :: Text -> [Text] -> Text
|
||||
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
|
||||
|
||||
-- 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
|
||||
|
||||
-- null:: [a] -> Bool
|
||||
on |null|(xs)
|
||||
if class of xs is string then
|
||||
xs = ""
|
||||
else
|
||||
xs = {}
|
||||
end if
|
||||
end |null|
|
||||
|
||||
-- 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
|
||||
|
||||
-- not :: Bool -> Bool
|
||||
on |not|(x)
|
||||
not x
|
||||
end |not|
|
||||
|
||||
-- quote :: String -> String
|
||||
on |quote|(x)
|
||||
quoted form of x
|
||||
end |quote|
|
||||
|
||||
-- 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
|
||||
|
||||
-- uncons :: [a] -> Maybe (a, [a])
|
||||
on uncons(xs)
|
||||
set lng to length of xs
|
||||
if lng > 0 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
|
||||
missing value
|
||||
end if
|
||||
end uncons
|
||||
|
||||
-- unlines :: [String] -> String
|
||||
on unlines(xs)
|
||||
intercalate(linefeed, xs)
|
||||
end unlines
|
||||
|
||||
-- words :: String -> [String]
|
||||
on |words|(s)
|
||||
words of s
|
||||
end |words|
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
set blocks to {"bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs", "jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}
|
||||
|
||||
canMakeWordWithBlocks("a", blocks)
|
||||
canMakeWordWithBlocks("bark", blocks)
|
||||
canMakeWordWithBlocks("book", blocks)
|
||||
canMakeWordWithBlocks("treat", blocks)
|
||||
canMakeWordWithBlocks("common", blocks)
|
||||
canMakeWordWithBlocks("squad", blocks)
|
||||
canMakeWordWithBlocks("confuse", blocks)
|
||||
|
||||
on canMakeWordWithBlocks(theString, constBlocks)
|
||||
copy constBlocks to theBlocks
|
||||
if theString = "" then return true
|
||||
set i to 1
|
||||
repeat
|
||||
if i > (count theBlocks) then exit repeat
|
||||
if character 1 of theString is in item i of theBlocks then
|
||||
set item i of theBlocks to missing value
|
||||
set theBlocks to strings of theBlocks
|
||||
if canMakeWordWithBlocks(rest of characters of theString as string, theBlocks) then
|
||||
return true
|
||||
end if
|
||||
end if
|
||||
set i to i + 1
|
||||
end repeat
|
||||
return false
|
||||
end canMakeWordWithBlocks
|
||||
Loading…
Add table
Add a link
Reference in a new issue