ABC problem

From Rosetta Code
Task
ABC problem
You are encouraged to solve this task according to the task description, using any language you may know.

You are given a collection of ABC blocks. Just like the ones you had when you were a kid. There are twenty blocks with two letters on each block. You are guaranteed to have a complete alphabet amongst all sides of the blocks. The sample blocks are:

((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))

The goal of this task is to write a function that takes a string and can determine whether you can spell the word with the given collection of blocks. The rules are simple:

  1. Once a letter on a block is used that block cannot be used again
  2. The function should be case-insensitive
  3. Show your output on this page for the following words:
Example

<lang python>

   >>> can_make_word("A")
   True
   >>> can_make_word("BARK")
   True
   >>> can_make_word("BOOK")
   False
   >>> can_make_word("TREAT")
   True
   >>> can_make_word("COMMON")
   False
   >>> can_make_word("SQUAD")
   True
   >>> can_make_word("CONFUSE")
   True

</lang>

Bracmat

<lang bracmat>(

 ( can-make-word
 =   ABC 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)
       : ?blocks
     & ( ABC
       =   letter blocks A Z
         .   !arg:(.?)
           |   !arg:(@(?:%?letter ?arg).?blocks)
             &   !blocks
               :   ?
                 + ?*(? !letter ?:?block)
                 + (?&ABC$(!arg.!blocks+-1*!block))
       )
     &   out
       $ ( !arg
           ( ABC$(upp$!arg.!blocks)&yes
           | no
           )
         )
 )

& can-make-word'A & can-make-word'BARK & can-make-word'BOOK & can-make-word'TREAT & can-make-word'COMMON & can-make-word'SQUAD & can-make-word'CONFUSE );</lang> Output:

A yes
BARK yes
BOOK no
TREAT yes
COMMON no
SQUAD yes
CONFUSE yes

C

Recursive solution. Empty string returns true. <lang c>#include <stdio.h>

  1. include <ctype.h>

int can_make_words(char **b, char *word) { int i, ret = 0, c = toupper(*word);

  1. define SWAP(a, b) if (a != b) { char * tmp = a; a = b; b = tmp; }

if (!c) return 1; if (!b[0]) return 0;

for (i = 0; b[i] && !ret; i++) { if (b[i][0] != c && b[i][1] != c) continue; SWAP(b[i], b[0]); ret = can_make_words(b + 1, word + 1); SWAP(b[i], b[0]); }

return ret; }

int main(void) { char* blocks[] = { "BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM", 0 };

char *words[] = { "", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse", 0 };

char **w; for (w = words; *w; w++) printf("%s\t%d\n", *w, can_make_words(blocks, *w));

return 0; }</lang>

Output:
        1
A       1
BARK    1
BOOK    0
TREAT   1
COMMON  0
SQUAD   1
Confuse 1


C++

Uses C++11. Build with g++-4.7 -Wall -std=c++0x abc.cpp <lang cpp>#include <iostream>

  1. include <vector>
  2. include <string>
  3. include <set>
  4. include <cctype>


typedef std::pair<char,char> item_t; typedef std::vector<item_t> list_t;

std::string can_make_word(const std::string& w, const list_t& vals) {

   std::set<uint32_t> used;
   while (used.size() < w.size()) {
       const char c = toupper(w[used.size()]);
       uint32_t x = used.size();
       for (uint32_t i = 0, ii = vals.size(); i < ii; ++i) {
           if (used.find(i) == used.end()) {
               if (toupper(vals[i].first) == c || toupper(vals[i].second) == c) {
                   used.insert(i);
                   break;
               }
           }
       }
       if (x == used.size()) break;
   }
   return (used.size() == w.size()) ? "True" : "False";

}


int main() {

   list_t vals{ {'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'} };
   std::vector<std::string> words{"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"};
   for (std::string& w : words) {
       std::cout << w << ": " << can_make_word(w,vals) << ".\n";
   }

} </lang>

A: True.
BARK: True.
BOOK: False.
TREAT: True.
COMMON: False.
SQUAD: True.
CONFUSE: True.


D

Translation of: Python

A simple greedy algorithm is enough for the given sequence of blocks. canMakeWord is true on an empty word because you can compose it using zero blocks. <lang d>import std.stdio, std.algorithm, std.string;

bool canMakeWord(in string word, in string[] blocks) pure /*nothrow*/ {

   auto bs = blocks.dup;
   outer: foreach (immutable ch; word.toUpper) {
       foreach (immutable block; bs)
           if (block.canFind(ch)) {
               bs = bs.remove(bs.countUntil(block));
               continue outer;
           }
       return false;
   }
   return true;

}

void main() {

   /*immutable*/
   const blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI
                   AN OB ER FS LY PC ZM".split;
   foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
       writefln(`"%s" %s`, word, canMakeWord(word, blocks));

}</lang>

Output:
"" true
"A" true
"BARK" true
"BoOK" false
"TrEAT" true
"COmMoN" false
"SQUAD" true
"conFUsE" true

Icon and Unicon

Translation of: C

Works in both languages: <lang unicon>procedure main(A)

   blocks := ["bo","xk","dq","cp","na","gt","re","tg","qd","fs",
              "jw","hu","vi","an","ob","er","fs","ly","pc","zm",&null]
   every write("\"",word := !A,"\" ",checkSpell(map(word),blocks)," with blocks.")

end

procedure checkSpell(w,blocks)

   blks := copy(blocks)
   w ? return if canMakeWord(blks) then "can be spelled"
                                   else "can not be spelled"

end

procedure canMakeWord(blks)

   c := move(1) | return
   if /blks[1] then fail
   every i := 1 to *blks do {
       if /blks[i] then (move(-1),fail)
       if c == !blks[i] then {  
           blks[1] :=: blks[i]
           if canMakeWord(blks[2:0]) then return
           blks[1] :=: blks[i]
           }
       }

end</lang>

Sample run:

->abc "" A BARK BOOK TREAT COMMON SQUAD CONFUSE
"" can be spelled with blocks.
"A" can be spelled with blocks.
"BARK" can be spelled with blocks.
"BOOK" can not be spelled with blocks.
"TREAT" can be spelled with blocks.
"COMMON" can not be spelled with blocks.
"SQUAD" can be spelled with blocks.
"CONFUSE" can be spelled with blocks.
->


J

Solution: <lang j>reduce=: verb define

 'rows cols'=. i.&.> $y
 for_c. cols do.
   r=. 1 i.~ c {"1 y             NB. row idx of first 1 in col
   if. r = #rows do. continue. end.
   y=. 0 (<((r+1)}.rows);c) } y  NB. zero rest of col
   y=. 0 (<(r;(c+1)}.cols)) } y  NB. zero rest of row
 end.

)

abc=: *./@(+./)@reduce@(e."1~ ,)&toupper :: 0:</lang> Examples: <lang j> Blocks=: ];._2 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM '

  ExampleWords=: <;._2 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
  Blocks&abc &> ExampleWords

1 1 0 1 0 1 1

  require 'format/printf'
  '%10s  %s' printf (dquote ; 'FT' {~ Blocks&abc) &> ExampleWords
      "A"  T
   "BaRK"  T
   "BOoK"  F
  "tREaT"  T
 "COmMOn"  F
  "SqUAD"  T
"CoNfuSE"  T</lang>

Perl 6

<lang perl6>my @blocks = map { EVAL "/:i $_/" },

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

sub can-spell-word($w is copy) {

   $w .= subst($_, ) for @blocks;
   $w eq ;

}

for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {

   say "$_     &can-spell-word($_)";

}</lang>

Output:
A	True
BaRK	True
BOoK	False
tREaT	True
COmMOn	False
SqUAD	True
CoNfuSE	True

PL/I

version 1

<lang pli>ABC: procedure options (main); /* 12 January 2014 */

  declare word character (20) varying, blocks character (200) varying initial
     ('((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))');
  declare tblocks character (200) varying;
  declare (true value ('1'b), false value ('0'b), flag) bit (1);
  declare ch character (1);
  declare (i, k) fixed binary;
  do word = 'A', 'BARK', 'BOOK', 'TREAT', 'COMMON', 'SQuAd', 'CONFUSE';
     flag = true;
     tblocks = blocks;
     do i = 1 to length(word);
        ch = substr(word, i, 1);
        k = index(tblocks, uppercase(ch));
        if k = 0 then
           flag = false;
        else /* Found a block with the letter on it. */
           substr(tblocks, k-1, 4) = '   '; /* Delete the block. */
     end;
     if flag then put skip list (word, 'true'); else put skip list (word, 'false');
  end;

end ABC;</lang>

A                       true 
BARK                    true 
BOOK                    false 
TREAT                   true 
COMMON                  false 
SQuAd                   true 
CONFUSE                 true

version 2

<lang pli>*process source attributes xref or(!) options nest;

abc: Proc Options(main);
/* REXX --------------------------------------------------------------
* 10.01.2013 Walter Pachl  counts the number of possible ways
* translated from Rexx version 2
*-------------------------------------------------------------------*/
Dcl (ADDR,HBOUND,INDEX,LEFT,LENGTH,MAX,SUBSTR,TRANSLATE) builtin;
Dcl sysprint Print;
Dcl (i,j,k,m,mm,wi,wj,wlen,ways,lw) Bin Fixed(15);
Dcl blocks(20) Char(2)
       Init('BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW',
            'HU','VI','AN','OB','ER','FS','LY','PC','ZM');
Dcl blk Char(2);
Dcl words(8) Char(7) Var
       Init('$','A','baRk','bOOk','trEat','coMMon','squaD','conFuse');
Dcl word     Char(7) Var;
Dcl c Char(1);
Dcl (show,cannot) Bit(1) Init('0'b);
Dcl poss(100,0:100) Pic'99';  poss=0;
Dcl s(20,100) char(100) Var;
Dcl str Char(100);
Dcl 1 *(30) Based(addr(str)),
     2 strp Pic'99',
     2 * Char(1);
Dcl ns(20) Bin Fixed(15) Init((20)0);
Dcl ol(100) Char(100) Var;
Dcl os      Char(100) Var;
wlen=0;
Dcl lower Char(26) Init('abcdefghijklmnopqrstuvwxyz');
Dcl upper Char(26) Init('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
Do wi=1 To hbound(words);
  wlen=max(wlen,length(words(wi)));
  End;
Do wi=1 To hbound(words);
  word = translate(words(wi),upper,lower);
  ways=0;
  lw=length(word);
  cannot='0'b;
  poss=0;
  ns=0;
  ol=;
iloop:
  Do i=1 To lw;                       /* loop over the characters   */
    c=substr(word,i,1);               /* the current character      */
    Do j=1 To hbound(blocks);         /* loop over blocks           */
      blk=blocks(j);
      If index(blk,c)>0 Then Do;  /* block can be used in this pos( */
        poss(i,0)+=1;        /* number of possible blocks for pos i */
        poss(i,poss(i,0))=j;
        End;
      End;
    If poss(i,0)=0 Then Do;
      Leave iloop;
      End;
    End;
  If i>lw Then Do;                     /* no prohibitive character  */
    ns=0;
    Do j=1 To poss(1,0);       /* build possible strings for char 1 */
      ns(1)+=1;;
      s(1,j)=poss(1,j);
      End;
    Do m=2 To lw;        /* build possible strings for chars 1 to i */
      mm=m-1;
      Do j=1 To ns(mm);
        Do k=1 To poss(m,0);
          ns(m)+=1;
          s(m,ns(m))=s(mm,j)!!' '!!poss(m,k);
          End;
        End;
      End;
    Do m=1 To ns(lw);
      If valid(s(lw,m)) Then Do;
        ways+=1;
        str=s(lw,m);
        Do k=1 To lw;
          ol(ways)=ol(ways)!!blocks(strp(k))!!' ';
          End;
        End;
      End;
    End;
/*--------------------------------------------------------------------
* now show the result
*-------------------------------------------------------------------*/
  os=left('!!word!!',wlen+2);
  Select;
    When(ways=0)
      os=os!!' cannot be spelt.';
    When(ways=1)
      os=os!!' can be spelt.';
    Otherwise
      os=os!!' can be spelt in'!!ways!!' ways.';
    End;
  Put Skip List(os);
  If show Then Do;
    Do wj=1 To ways;
      Put Edit('          '!!ol(wj))(Skip,a);
      End;
    End;
  End;
Return;
valid: Procedure(list) Returns(bit(1));
/*--------------------------------------------------------------------
* Check if the same block is used more than once -> 0
* Else: the combination is valid
*-------------------------------------------------------------------*/
Dcl list Char(*) Var;
Dcl i Bin Fixed(15);
Dcl used(20) Bit(1);
str=list;
used='0'b;
Do i=1 To lw;
  If used(strp(i)) Then
    Return('0'b);
  used(strp(i))='1'b;
  End;
Return('1'b);
End;
End;</lang>

output

'$'       cannot be spelt.
'A'       can be spelt in        2 ways.
'BARK'    can be spelt in        8 ways.
'BOOK'    cannot be spelt.
'TREAT'   can be spelt in        8 ways.
'COMMON'  cannot be spelt.
'SQUAD'   can be spelt in        8 ways.
'CONFUSE' can be spelt in       32 ways.

Python

Python: Iterative, with tests

<lang python> 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")]


def can_make_word(word, block_collection=blocks):

   """
   Return True if `word` can be made from the blocks in `block_collection`.
   >>> can_make_word("")
   False
   >>> can_make_word("a")
   True
   >>> can_make_word("bark")
   True
   >>> can_make_word("book")
   False
   >>> can_make_word("treat")
   True
   >>> can_make_word("common")
   False
   >>> can_make_word("squad")
   True
   >>> can_make_word("coNFused")
   True
   """
   if not word:
       return False
   blocks_remaining = block_collection[:]
   for char in word.upper():
       for block in blocks_remaining:
           if char in block:
               blocks_remaining.remove(block)
               break
       else:
           return False
   return True


if __name__ == "__main__":

   import doctest
   doctest.testmod()
   print(", ".join("'%s': %s" % (w, can_make_word(w)) for w in
                   ["", "a", "baRk", "booK", "treat", 
                    "COMMON", "squad", "Confused"]))

</lang>

Output:
'': False, 'a': True, 'baRk': True, 'booK': False, 'treat': True, 'COMMON': False, 'squad': True, 'Confused': True

Python: Recursive

<lang python>BLOCKS = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'.split()

def _abc(word, blocks):

   for i, ch in enumerate(word):
       for blk in (b for b in blocks if ch in b):
           whatsleft = word[i + 1:]
           blksleft = blocks[:]
           blksleft.remove(blk)
           if not whatsleft: 
               return True, blksleft
           if not blksleft: 
               return False, blksleft
           ans, blksleft = _abc(whatsleft, blksleft)
           if ans:
               return ans, blksleft
       else:
           break
   return False, blocks

def abc(word, blocks=BLOCKS):

   return _abc(word.upper(), blocks)[0]

if __name__ == '__main__':

   for word in [] + 'A BARK BoOK TrEAT COmMoN SQUAD conFUsE'.split():
       print('Can we spell %9r? %r' % (word, abc(word)))</lang>
Output:
Can we spell       ''? False
Can we spell       'A'? True
Can we spell    'BARK'? True
Can we spell    'BoOK'? False
Can we spell   'TrEAT'? True
Can we spell  'COmMoN'? False
Can we spell   'SQUAD'? True
Can we spell 'conFUsE'? True

Python: Recursive, telling how

<lang python>BLOCKS = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'.split()

def __abc(word, blocks, used):

   for i, ch in enumerate(word):
       for blk in (b for b in blocks if ch in b):
           whatsleft = word[i + 1:]
           blksleft = blocks[:]
           blksleft.remove(blk)
           _used = used + [(ch, blk)]
           if not whatsleft: 
               return True, blksleft, _used
           elif not blksleft: 
               return False, blksleft, _used
           else:
               ans, blksleft, _used = __abc(whatsleft, blksleft, _used)
               if ans:
                   return ans, blksleft, _used
       else:
           break
   return False, blocks, used

def abc2(word, blocks=BLOCKS):

   ans, blksleft, used = __abc(word.upper(), blocks, [])
   if ans:
       how = ' Using: ' + ', '.join('%s from %r' % u for u in used)
   else:
       how = 
   return ans, how

if __name__ == '__main__':

   print('BLOCKS: ' + ' '.join(BLOCKS) + '\n')
   for word in [] + 'A BARK BoOK TrEAT COmMoN SQUAD conFUsEd AuTO'.split():
       ans, how = abc2(word, blocks=BLOCKS)
       print('Can we spell %9r? %r%s' % (word, ans, how))</lang>
Output:
BLOCKS: BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM

Can we spell        ''? False
Can we spell       'A'? True Using: A from 'NA'
Can we spell    'BARK'? True Using: B from 'BO', A from 'NA', R from 'RE', K from 'XK'
Can we spell    'BoOK'? False
Can we spell   'TrEAT'? True Using: T from 'GT', R from 'RE', E from 'ER', A from 'NA', T from 'TG'
Can we spell  'COmMoN'? False
Can we spell   'SQUAD'? True Using: S from 'FS', Q from 'DQ', U from 'HU', A from 'NA', D from 'QD'
Can we spell 'conFUsEd'? True Using: C from 'CP', O from 'BO', N from 'NA', F from 'FS', U from 'HU', S from 'FS', E from 'RE', D from 'DQ'
Can we spell    'AuTO'? True Using: A from 'NA', U from 'HU', T from 'GT', O from 'BO'

Racket

I believe you can make an empty word by using no blocks. So '(can-make-word? "")' is true for me.

<lang racket>#lang racket (define block-strings

 (list "BO" "XK" "DQ" "CP" "NA"
       "GT" "RE" "TG" "QD" "FS"
       "JW" "HU" "VI" "AN" "OB"
       "ER" "FS" "LY" "PC" "ZM"))

(define BLOCKS (map string->list block-strings))

(define (can-make-word? w)

 (define (usable-block blocks word-char)
   (for/first ((b (in-list blocks)) #:when (memf (curry char-ci=? word-char) b)) b))
 
 (define (inner word-chars blocks tried-blocks)
   (cond
     [(null? word-chars) #t]
     [(usable-block blocks (car word-chars))
      =>
      (lambda (b)
        (or
         (inner (cdr word-chars) (append tried-blocks (remove b blocks)) null)
         (inner word-chars (remove b blocks) (cons b tried-blocks))))]
     [else #f]))
 (inner (string->list w) BLOCKS null))

(define WORD-LIST '("" "A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE")) (define (report-word w)

 (printf "Can we make: ~a? ~a~%"
         (~s w #:min-width 9)
         (if (can-make-word? w) "yes" "no")))

(module+ main

 (for-each report-word WORD-LIST))  

(module+ test

 (require rackunit)
 (check-true  (can-make-word? ""))
 (check-true  (can-make-word? "A"))
 (check-true  (can-make-word? "BARK"))
 (check-false (can-make-word? "BOOK"))
 (check-true  (can-make-word? "TREAT"))
 (check-false (can-make-word? "COMMON"))
 (check-true  (can-make-word? "SQUAD"))
 (check-true  (can-make-word? "CONFUSE")))</lang>
Output:
Can we make: ""       ? yes
Can we make: "A"      ? yes
Can we make: "BARK"   ? yes
Can we make: "BOOK"   ? no
Can we make: "TREAT"  ? yes
Can we make: "COMMON" ? no
Can we make: "SQUAD"  ? yes
Can we make: "CONFUSE"? yes

REXX

version 1

<lang rexx>/*REXX pgm checks if a word list can be spelt from a pool of toy blocks.*/ list = 'A bark bOOk treat common squaD conFuse' /*words can be any case.*/ blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'

      do k=1  for  words(list)        /*traipse through list of words. */
      call  spell  word(list,k)       /*show if word be spelt (or not).*/
      end   /*k*/                     /* [↑] tests each word in list.  */

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SPELL subroutine────────────────────*/ spell: procedure expose blocks; parse arg ox . 1 x . /*get word to spell*/ z=blocks; upper x z; oz=z; p.=0; L=length(x) /*uppercase the blocks. */

                                               /* [↓]  try to spell it.*/
 do try=1  for  L;   z=oz                      /*use a fresh copy of Z.*/
   do n=1  for  L;   y=substr(x,n,1)           /*attempt another letter*/
   p.n=pos(y,z,1+p.n); if p.n==0 then iterate try /*¬ found? Try again.*/
   z=overlay(' ',z,p.n)                        /*mutate block──► onesy.*/
     do k=1  for words(blocks)                 /*scrub block pool (¬1s)*/
     if length(word(z,k))==1  then z=delword(z,k,1)  /*1 char?  Delete.*/
     end   /*k*/                               /* [↑]  elide any onesy.*/
   if n==L   then leave try                    /*the last letter spelt?*/
   end     /*n*/                               /* [↑] end of an attempt*/
 end       /*try*/                             /* [↑]  end TRY permute.*/

say right(ox,30) right(word("can't can", (n==L)+1), 6) 'be spelt.' return n==L /*also, return the flag.*/</lang> output

                             A    can be spelt.
                          bark    can be spelt.
                          bOOk  can't be spelt.
                         treat    can be spelt.
                        common  can't be spelt.
                         squaD    can be spelt.
                       conFuse    can be spelt.  

version 2

<lang rexx>/* REXX ---------------------------------------------------------------

  • 10.01.2013 Walter Pachl counts the number of possible ways
  • --------------------------------------------------------------------*/

show=(arg(1)<>) blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM' list = '$ A baRk bOOk trEat coMMon squaD conFuse' list=translate(list) Do i=1 To words(blocks)

 blkn.i=word(blocks,i)'-'i
 blk.i=word(blocks,i)
 End

w.= wlen=0 Do i=1 To words(list)

 w.i=word(list,i)
 wlen=max(wlen,length(w.i))
 End

Do wi=0 To words(list)

 word = w.wi
 ways=0
 poss.=0
 lw=length(word)
 cannot=0
 Do i=1 To lw                         /* loop over the characters   */
   c=substr(word,i,1)                 /* the current character      */
   Do j=1 To words(blocks)            /* loop over blocks           */
     blk=word(blocks,j)
     If pos(c,blk)>0 Then Do  /* block can be used in this position */
       z=poss.i.0+1
       poss.i.z=j
       poss.i.0=z            /* number of possible blocks for pos i */
       End
     End
   If poss.i.0=0 Then Do
     cannot=1
     Leave i
     End
   End
 If cannot=0 Then Do                  /* no prohibitive character   */
   s.=0
   Do j=1 To poss.1.0          /* build possible strings for char 1 */
     z=s.1.0+1
     s.1.z=poss.1.j
     s.1.0=z
     End
   Do i=2 To lw          /* build possible strings for chars 1 to i */
     ii=i-1
     Do j=1 To poss.i.0
       Do k=1 To s.ii.0
         z=s.i.0+1
         s.i.z=s.ii.k poss.i.j
         s.i.0=z
         End
       End
     End
   Do p=1 To s.lw.0            /* loop through all possible strings */
     v=valid(s.lw.p)                  /* test if the string is valid*/
     If v Then Do                     /* it is                      */
       ways=ways+1                    /* increment number of ways   */
       way.ways=                 /* and store the string's blocks */
       Do ii=1 To lw
         z=word(s.lw.p,ii)
         way.ways=way.ways blk.z
         End
       End
     End
   End

/*---------------------------------------------------------------------

  • now show the result
  • --------------------------------------------------------------------*/
 ol=left('word',wlen)
 Select
   When ways=0 Then
     ol=ol 'cannot be spelt'
   When ways=1 Then
     ol=ol 'can be spelt'
   Otherwise
     ol=ol 'can be spelt in' ways 'ways'
   End
 Say ol'.'
 If show Then Do
   Do wj=1 To ways
     Say copies(' ',10) way.wj
     End
   End
 End

Exit

valid: Procedure /*---------------------------------------------------------------------

  • Check if the same block is used more than once -> 0
  • Else: the combination is valid
  • --------------------------------------------------------------------*/
 Parse Arg list
 used.=0
 Do i=1 To words(list)
   w=word(list,i)
   If used.w Then Return 0
   used.w=1
   End
 Return 1</lang>

output

''      cannot be spelt.
'$'     cannot be spelt.
'A'     can be spelt in 2 ways.
'BARK'  can be spelt in 8 ways.
'BOOK'  cannot be spelt.
'TREAT' can be spelt in 8 ways.
'COMMON cannot be spelt.
'SQUAD' can be spelt in 8 ways.
'CONFUS can be spelt in 32 ways.

extended output

''      cannot be spelt.
'$'     cannot be spelt.
'A'     can be spelt in 2 ways.
            NA
            AN
'BARK'  can be spelt in 8 ways.
            BO NA RE XK
            OB NA RE XK
            BO AN RE XK
            OB AN RE XK
            BO NA ER XK
            OB NA ER XK
            BO AN ER XK
            OB AN ER XK
'BOOK'  cannot be spelt.
'TREAT' can be spelt in 8 ways.
            TG ER RE NA GT
            TG RE ER NA GT
            TG ER RE AN GT
            TG RE ER AN GT
            GT ER RE NA TG
            GT RE ER NA TG
            GT ER RE AN TG
            GT RE ER AN TG
'COMMON cannot be spelt.
'SQUAD' can be spelt in 8 ways.
            FS QD HU NA DQ
            FS QD HU NA DQ
            FS QD HU AN DQ
            FS QD HU AN DQ
            FS DQ HU NA QD
            FS DQ HU NA QD
            FS DQ HU AN QD
            FS DQ HU AN QD
'CONFUS can be spelt in 32 ways.
            CP BO NA FS HU FS RE
            PC BO NA FS HU FS RE
            CP OB NA FS HU FS RE
            PC OB NA FS HU FS RE
            CP BO AN FS HU FS RE
            PC BO AN FS HU FS RE
            CP OB AN FS HU FS RE
            PC OB AN FS HU FS RE
            CP BO NA FS HU FS RE
            PC BO NA FS HU FS RE
            CP OB NA FS HU FS RE
            PC OB NA FS HU FS RE
            CP BO AN FS HU FS RE
            PC BO AN FS HU FS RE
            CP OB AN FS HU FS RE
            PC OB AN FS HU FS RE
            CP BO NA FS HU FS ER
            PC BO NA FS HU FS ER
            CP OB NA FS HU FS ER
            PC OB NA FS HU FS ER
            CP BO AN FS HU FS ER
            PC BO AN FS HU FS ER
            CP OB AN FS HU FS ER
            PC OB AN FS HU FS ER
            CP BO NA FS HU FS ER
            PC BO NA FS HU FS ER
            CP OB NA FS HU FS ER
            PC OB NA FS HU FS ER
            CP BO AN FS HU FS ER
            PC BO AN FS HU FS ER
            CP OB AN FS HU FS ER
            PC OB AN FS HU FS ER

Ruby

This one uses a case insensitive regular expression. The 'sub!' method substitutes the first substring it finds and returns nil if nothing is found. <lang ruby>words = %w(A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE) << ""

words.each do |word|

 blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
 res = word.each_char.all?{|c| blocks.sub!(/\w?#{c}\w?/i, "")}  #regexps can be interpolated like strings
 puts "#{word.inspect}: #{res}"

end </lang>

Output:
"A": true
"BaRK": true
"BOoK": false
"tREaT": true
"COmMOn": false
"SqUAD": true
"CoNfuSE": true
"": true

Tcl

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6

proc abc {word {blocks {BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM}}} {

   set abc {{letters blocks abc} {

set rest [lassign $letters ch] set i 0 foreach blk $blocks { if {$ch in $blk && (![llength $rest] || [apply $abc $rest [lreplace $blocks $i $i] $abc])} { return true } incr i } return false

   }}
   return [apply $abc [split $word ""] [lmap b $blocks {split $b ""}] $abc]

}

foreach word {"" A BARK BOOK TREAT COMMON SQUAD CONFUSE} {

   puts [format "Can we spell %9s? %s" '$word' [abc $word]]

}</lang>

Output:
Can we spell        ''? false
Can we spell       'A'? true
Can we spell    'BARK'? true
Can we spell    'BOOK'? false
Can we spell   'TREAT'? true
Can we spell  'COMMON'? false
Can we spell   'SQUAD'? true
Can we spell 'CONFUSE'? true