Data commit

Task/ABC-problem/AppleScript/abc-problem-1.applescript

@@ -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

Task/ABC-problem/AppleScript/abc-problem-2.applescript

@@ -0,0 +1,45 @@
+on canMakeWordWithBlocks(theString, theBlocks)
+    set stringLen to (count theString)
+    copy theBlocks to theBlocks
+    script o
+        on cmw(c, theBlocks)
+            set i to 1
+            repeat until (i > (count theBlocks))
+                if (character c of theString is in item i of theBlocks) then
+                    if (c = stringLen) then return true
+                    set item i of theBlocks to missing value
+                    set theBlocks to text of theBlocks
+                    if (cmw(c + 1, theBlocks)) then return true
+                end if
+                set i to i + 1
+            end repeat
+
+            return false
+        end cmw
+    end script
+
+    ignoring case -- Make the default case insensitivity explicit.
+        return ((theString = "") or (o's cmw(1, theBlocks)))
+    end ignoring
+end canMakeWordWithBlocks
+
+on join(lst, delim)
+    set astid to AppleScript's text item delimiters
+    set AppleScript's text item delimiters to delim
+    set txt to lst as text
+    set AppleScript's text item delimiters to astid
+    return txt
+end join
+
+on task()
+    set blocks to {"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", ¬
+        "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"}
+    set output to {}
+    repeat with testWord in {"a", "bark", "book", "treat", "common", "squad", "confuse"}
+        set end of output to "Can make “" & testWord & "”: " & ¬
+            canMakeWordWithBlocks(testWord's contents, blocks)
+    end repeat
+    return join(output, linefeed)
+end task
+
+task()

Task/ABC-problem/AppleScript/abc-problem-3.applescript

@@ -0,0 +1,7 @@
+"Can make “a”: true
+Can make “bark”: true
+Can make “book”: false
+Can make “treat”: true
+Can make “common”: false
+Can make “squad”: true
+Can make “confuse”: true"

Task/ABC-problem/AppleScript/abc-problem-4.applescript

@@ -0,0 +1,197 @@
+use AppleScript version "2.4"
+use framework "Foundation"
+
+----------------------- ABC Problem -----------------------
+
+-- spellWith :: [String] -> [Char] -> [[String]]
+on spellWith(blocks, cs)
+    if 0 < length of cs then
+        set x to item 1 of cs
+        script go
+            on |λ|(b)
+                if b contains x then
+                    map(my cons(b), ¬
+                        spellWith(|delete|(b, blocks), rest of cs))
+                else
+                    {}
+                end if
+            end |λ|
+        end script
+        concatMap(go, blocks)
+    else
+        {{}}
+    end if
+end spellWith
+
+
+-------------------------- TEST ---------------------------
+on run
+    set blocks to ¬
+        words of "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
+
+    script test
+        on |λ|(w)
+            justifyRight(9, space, quoted("'", w)) & " -> " & ¬
+                ({} ≠ spellWith(blocks, characters of toUpper(w)))
+        end |λ|
+    end script
+
+    unlines(map(test, ¬
+        ["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]))
+end run
+
+
+-------------------- GENERIC FUNCTIONS --------------------
+
+-- Just :: a -> Maybe a
+on Just(x)
+    -- Constructor for an inhabited Maybe (option type) value.
+    -- Wrapper containing the result of a computation.
+    {type:"Maybe", Nothing:false, Just:x}
+end Just
+
+
+-- Nothing :: Maybe a
+on Nothing()
+    -- Constructor for an empty Maybe (option type) value.
+    -- Empty wrapper returned where a computation is not possible.
+    {type:"Maybe", Nothing:true}
+end Nothing
+
+
+-- elemIndex :: Eq a => 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 Just(i)
+    end repeat
+    return Nothing()
+end elemIndex
+
+
+-- 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
+    return acc
+end concatMap
+
+
+-- cons :: a -> [a] -> [a]
+on cons(x)
+    script
+        on |λ|(xs)
+            {x} & xs
+        end |λ|
+    end script
+end cons
+
+
+-- delete :: Eq a => a -> [a] -> [a]
+on |delete|(x, xs)
+    set mbIndex to elemIndex(x, xs)
+    set lng to length of xs
+
+    if Nothing of mbIndex then
+        xs
+    else
+        if 1 < lng then
+            set i to Just of mbIndex
+            if 1 = i then
+                items 2 thru -1 of xs
+            else if lng = i then
+                items 1 thru -2 of xs
+            else
+                tell xs to items 1 thru (i - 1) & items (i + 1) thru -1
+            end if
+        else
+            {}
+        end if
+    end if
+end |delete|
+
+
+-- justifyRight :: Int -> Char -> String -> String
+on justifyRight(n, cFiller, strText)
+    if n > length of strText then
+        text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
+    else
+        strText
+    end if
+end justifyRight
+
+
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
+on mReturn(f)
+    -- 2nd class handler function lifted into 1st class script wrapper.
+    if script is class of f then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+
+-- 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
+
+
+-- quoted :: Char -> String -> String
+on quoted(c, s)
+    -- string flanked on both sides
+    -- by a specified quote character.
+    c & s & c
+end quoted
+
+
+-- replicate :: Int -> String -> String
+on replicate(n, s)
+    set out to ""
+    if n < 1 then return out
+    set dbl to s
+
+    repeat while (n > 1)
+        if (n mod 2) > 0 then set out to out & dbl
+        set n to (n div 2)
+        set dbl to (dbl & dbl)
+    end repeat
+    return out & dbl
+end replicate
+
+
+-- 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
+
+
+-- unlines :: [String] -> String
+on unlines(xs)
+    -- A single string formed by the intercalation
+    -- of a list of strings with the newline character.
+    set {dlm, my text item delimiters} to ¬
+        {my text item delimiters, linefeed}
+    set s to xs as text
+    set my text item delimiters to dlm
+    s
+end unlines