Update all new Tasks

Task/ABC-Problem/TXR/abc-problem.txr

@@ -0,0 +1,47 @@
+@(do
+   (defvar blocks '((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G)
+                    (Q D) (F S) (J W) (H U) (V I) (A N) (O B) (E R)
+                    (F S) (L Y) (P C) (Z M)))
+
+   ;; Define and build hash which maps each letter that occurs in blocks
+   ;; to a list of the blocks in which that letter occurs.
+
+   (defvar alpha2blocks [hash-uni [group-by first blocks]
+                                  [group-by second blocks]
+                                  append])
+
+   ;; convert, e.g. "abc" -> (A B C)
+   ;; intern -- convert a string to an interned symbol "A" -> A
+   ;; tuples -- turn string into 1-element tuples: "ABC" -> ("A" "B" "C")
+   ;; square brackets around mapcar -- Lisp-1 style evaluation, allowing
+   ;;   the intern function binding to be treated as a variable binding.
+
+   (defun string-to-syms (str)
+     [mapcar intern (tuples 1 (upcase-str str))])
+
+   ;; Recursive part of algorithm working purely with Lisp symbols.
+   ;; alpha -- single symbol denoting a letter
+   ;; [alpha2blocks alpha] -- look up list of blocks for given letter
+   ;; (memq item list) -- is item a member of list, under eq equality?
+   ;; (remq item list) -- remove items from list which are eq to item.
+
+   (defun can-make-word-guts (letters blocks)
+     (cond
+       ((null letters) t)
+       ((null blocks) nil)
+       (t (let ((alpha (first letters)))
+            (each ((bl [alpha2blocks alpha]))
+              (if (and (memq bl blocks)
+                       (can-make-word-guts (rest letters)
+                                           (remq bl blocks)))
+                (return-from can-make-word-guts t)))))))
+
+   (defun can-make-word (str)
+     (can-make-word-guts (string-to-syms str) blocks)))
+@(repeat)
+@w
+@(output)
+>>> can_make_word("@(upcase-str w)")
+@(if (can-make-word w) "True" "False")
+@(end)
+@(end)