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:
- Once a letter on a block is used that block cannot be used again
- The function should be case-insensitive
- 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>
- include <ctype.h>
int can_make_words(char **b, char *word) { int i, ret = 0, c = toupper(*word);
- 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
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
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>
PL/I
<lang PL/I>ABC: procedure options (main); /* 11 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 (true value ('1'b), false value ('0'b), flag) bit (1); declare Alphabet character (26) initial ('ABCDEFGHIJKLMNOPQRSTUVWXYZ'); declare quantity (26) fixed binary, tquantity (26) fixed binary; declare ch character (1); declare (i, k) fixed binary;
/* Tally each unique letter from the available blocks */ do i = 1 to 26; ch = substr(Alphabet, i, 1); quantity(i) = tally(blocks, ch); end;
do word = 'A', 'BARK', 'BOOK', 'TREAT', 'COMMON', 'SQuAd', 'CONFUSE'; flag = true; tquantity = quantity; do i = 1 to length(word); ch = substr(word, i, 1); k = index(Alphabet, uppercase(ch)); if tquantity(k) <= 0 then flag = false; tquantity(k) = tquantity(k) - 1; end; if flag then put skip list (word, 'true'); else put skip list (word, 'false'); end;
end ABC;</lang> Results:
A true BARK true BOOK true TREAT true COMMON false SQuAd true CONFUSE true
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
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 .; OK=0 /*get word.*/ 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,max(1,1+p.n)) /*try to find the letter*/ if p.n==0 then iterate try /*Not 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.*/ OK= (n==L) /*the last letter spelt?*/ if OK then leave try /*Yes? Then word spelt.*/ end /*n*/ /* [↑] end of an attempt*/ end /*try*/ /* [↑] end TRY permute.*/
say right(ox,30) right(word("can't can", OK+1), 6) 'be spelt.' return OK /*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
<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