ABC problem

From Rosetta Code
Revision as of 00:57, 10 January 2014 by rosettacode>Gerard Schildberger (→‎{{header|REXX}}: allowed longer words, fixed a possible error during some failed attempts, simplified the handling of orphaned blocks. -- ~~~~)
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("")
   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("CONFUSE")
   True

</lang>

C

This example is incorrect. Please fix the code and remove this message.

Details: Currently the task has the null string as False. Check/add to the talk page discussion.

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

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

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

0 1 1 0 1 0 1 1

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

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

Racket

This example is incorrect. Please fix the code and remove this message.

Details: Currently the task has the null string as False and check/add to the talk page discussion

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

<lang rexx>/*REXX pgm checks if some words can be spelt from a pool of toy blocks. */ 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' /*words can be any case.*/

    do k=0  to words(list)                     /*traipse through list. */
    if k==0  then call can_make_word         /*perform a  NULL  test.*/
             else call can_make_word word(list,k)  /*···a vanilla test.*/
    end   /*k*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────CAN_MAKE_WORD subroutine────────────*/ can_make_word: procedure expose blocks; arg x . /*X: word to be built. */ z=' ' blocks " "; z=translate(z); oz=z /*pad pool, uppercase it*/ try=0; n=0; OK=0; L=length(x); trip=L*L+L /*set some REXX vars. */

                                               /* [↓]  try to spell it.*/
 do try=1  while try<trip*2;        n=n+1      /*bump the character ptr*/
 y=substr(x,n,1)                               /*find particular letter*/
 if try>trip  then do; z=oz; n=0; iterate; end /*use a fresh copy of Z?*/
 if try//2  then p=    pos(y,z)                /*try to find letter by */
            else p=lastpos(y,z)                /*one method or another.*/
 if p==0    then do;  n=0;  iterate;  end      /*Not found?  Try again.*/
 z=overlay(' ',z,p)                            /*transform block─► 1-sy*/
             do k=1  for words(z); _=word(z,k) /*scrub block pool (¬1s)*/
             if length(_)==1  then z=delword(z,k,1)  /*is block 1 char?*/
             end   /*k*/                       /* [↑]   elide any 1─sy.*/
 OK= n==L                                      /*a flag:  spelt or not.*/
 if OK  then leave                             /*all the letters found?*/
 end   /*n*/

if x== then x="(null)" /*express a NULL better.*/ say right(x,30) right(word("can't can", OK+1), 6) 'be spelt.' return OK /*also, return the flag.*/</lang>

Output:
                        (null)  can't be spelt.
                             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. 

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