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 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=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 the word.*/ z=blocks; upper x z; oz=z; L=length(x) /*uppercase the blocks. */ try=0; n=0; OK=0; trip=L*L+L /*set some REXX vars. */
/* [↓] try to spell it.*/
do try=1 while try<trip*2; n=n+1 /*bump pointer to letter*/
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(blocks) /*scrub block pool (¬1s)*/
if length(word(z,k))==1 then z=delword(z,k,1) /*is block 1 char?*/
end /*k*/ /* [↑] elide any 1─sy.*/
OK= n==L /*the last letter spelt?*/
if OK then leave /*Yes? Then word spelt.*/
end /*n*/
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