48 lines
1.8 KiB
Plaintext
48 lines
1.8 KiB
Plaintext
@(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)
|