ABC problem: Difference between revisions

152,715 bytes added ,  2 months ago
Add ABC
(Add ABC)
 
(213 intermediate revisions by 83 users not shown)
Line 1:
[[Category:Puzzles]]
[[Category:Games]]
 
{{task}}
 
Line 41 ⟶ 44:
 
;Example:
<langsyntaxhighlight lang="python"> >>> can_make_word("A")
True
>>> can_make_word("BARK")
Line 54 ⟶ 57:
True
>>> can_make_word("CONFUSE")
True</langsyntaxhighlight>
 
{{Template:Strings}}
<br><br>
 
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">F can_make_word(word)
I word == ‘’
R 0B
 
V blocks_remaining = ‘BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM’.split(‘ ’)
 
L(ch) word.uppercase()
L(block) blocks_remaining
I ch C block
blocks_remaining.remove(block)
L.break
L.was_no_break
R 0B
R 1B
 
print([‘’, ‘a’, ‘baRk’, ‘booK’, ‘treat’, ‘COMMON’, ‘squad’, ‘Confused’].map(w -> ‘'’w‘': ’can_make_word(w)).join(‘, ’))</syntaxhighlight>
 
=={{header|360 Assembly}}==
The program uses one ASSIST macro (XPRNT) to keep the code as short as possible.
<syntaxhighlight lang="360asm">* ABC Problem 21/07/2016
ABC CSECT
USING ABC,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) " <-
ST R15,8(R13) " ->
LR R13,R15 " addressability
LA R8,1 l=1
LOOPL C R8,=A(NN) do l=1 to hbound(words)
BH ELOOPL
LR R1,R8 l
MH R1,=H'20' *20
LA R10,WORDS-20(R1) @words(l)
MVC STATUS,=CL5'true' cflag='true'
MVC TBLOCKS,BLOCKS tblocks=blocks
MVC CC(1),0(R10) cc=substr(words(l),1,1)
LA R6,1 i=1
LOOPI CLI CC,C' ' do while cc<>' '
BE ELOOPI
SR R7,R7 k=0
LH R0,=H'1' m=1
LOOPM CH R0,=AL2(L'TBLOCKS) do m=1 to length(tblocks)
BH ELOOPM
LA R5,TBLOCKS-1 @tblocks[0]
AR R5,R0 @tblocks[m]
CLC 0(1,R5),CC if substr(tblocks,m,1)=cc
BNE INDEXM
LR R7,R0 k=m=index(tblocks,cc)
B ELOOPM
INDEXM AH R0,=H'1' m=m+1
B LOOPM
ELOOPM LTR R7,R7 if k=0
BNZ OKK
MVC STATUS,=CL5'false' cflag='false'
B EIFK0
OKK LA R4,TBLOCKS-2 @tblocks[-1]
AR R4,R7 +k
CLI 0(R4),C'(' if substr(tblocks,k-1,1)='('
BNE SECOND
LA R0,1 j=1
B EIFBLOCK
SECOND LA R0,3 j=3
EIFBLOCK LR R2,R7 k
SR R2,R0 k-j
LA R4,TBLOCKS-1 @tblocks[0]
AR R4,R2 @tblocks[k-j]
MVC 0(5,R4),=CL5' ' substr(tblocks,k-j,5)=' '
EIFK0 LA R6,1(R6) i=i+1
LR R4,R10 @words
AR R4,R6 +i
BCTR R4,0 -1
MVC CC,0(R4) cc=substr(words,i,1)
B LOOPI
ELOOPI MVC PG(20),0(R10) tabword(l)
MVC PG+20(5),STATUS status
XPRNT PG,80 print buffer
LA R8,1(R8) l=l+1
B LOOPL
ELOOPL L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
WORDS DC CL20'A',CL20'BARK',CL20'BOOK',CL20'TREAT',CL20'COMMON'
DC CL20'SQUAD',CL20'CONFUSE'
BLOCKS DS 0CL122
DC CL61'((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) '
DC CL61'(J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M)) '
TBLOCKS DS CL(L'BLOCKS) work blocks
CC DS CL1 letter to find
STATUS DS CL5 true/false
PG DC CL80' ' buffer
YREGS
NN EQU (BLOCKS-WORDS)/L'WORDS number of words
END ABC</syntaxhighlight>
{{out}}
<pre>
A true
BARK true
BOOK false
TREAT true
COMMON false
SQUAD true
CONFUSE true
</pre>
 
=={{header|8080 Assembly}}==
<syntaxhighlight lang="8080asm"> org 100h
jmp test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Subroutine 'blocks': takes a $-terminated string in
;;; DE containing a word, and checks whether it can be
;;; written with the blocks.
;;; Returns: carry flag set if word is accepted.
;;; Uses registers: A, B, D, E, H, L
blocks: push d ; Store string pointer
lxi h,blockslist ; At the start, all blocks are
lxi d,blocksavail ; available
mvi b,40
blocksinit: mov a,m
stax d
inx h
inx d
dcr b
jnz blocksinit
pop d ; Restore string pointer
blockschar: ldax d ; Get current character
cpi '$' ; End of string?
stc ; Set carry flag (accept string)
rz ; And then we're done
ani 0DFh ; Make uppercase
lxi h,blocksavail ; Is it available?
mvi b,40
blockscheck: cmp m
jz blocksaccept ; Yes, we found it
inx h ; Try next available char
dcr b
jnz blockscheck
ana a ; Char unavailable, clear
ret ; carry and stop.
blocksaccept: mvi m,0 ; We've now used this char
mov a,l ; And its blockmate
xri 1
mov l,a
mvi m,0
inx d ; Try next char in string
jmp blockschar
;; Note: 'blocksavail' must not cross page boundary
blockslist: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
blocksavail: ds 40
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Test code: run the subroutine on the given words.
test: lxi h,words
doword: mov e,m ; Get pointer to next word
inx h
mov d,m
inx h
mov a,e ; If zero, end of word list
ora d
rz
push h ; Save pointer to list
push d ; Save pointer to word
mvi c,9 ; Write word to console
call 5
pop d ; Retrieve word ponter
call blocks ; Run the 'blocks' routine
lxi d,yes ; Say 'yes',
jc yesno ; if the carry is set.
lxi d,no ; Otherwise, say 'no'.
yesno: mvi c,9
call 5
pop h ; Restore list pointer
jmp doword ; Do next word
yes: db ': Yes',13,10,'$'
no: db ': No',13,10,'$'
words: dw wrda,wrdbark,wrdbook,wrdtreat,wrdcommon
dw wrdsquad,wrdconfuse,0
wrda: db 'A$'
wrdbark: db 'BARK$'
wrdbook: db 'BOOK$'
wrdtreat: db 'TREAT$'
wrdcommon: db 'COMMON$'
wrdsquad: db 'SQUAD$'
wrdconfuse: db 'CONFUSE$'</syntaxhighlight>
 
{{out}}
 
<pre>A>blocks
A: Yes
BARK: Yes
BOOK: No
TREAT: Yes
COMMON: No
SQUAD: Yes
CONFUSE: Yes</pre>
 
=={{header|8086 Assembly}}==
{{trans|8080 Assembly}}
 
<syntaxhighlight lang="asm"> cpu 8086
bits 16
org 100h
section .text
jmp demo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Subroutine "blocks": see if the $-terminated string in DS:BX
;;; can be written with the blocks.
;;; Returns: carry flag set if word is accepted.
;;; Uses registers: AL, BX, CX, SI, DI
;;; Assumes CS=DS=ES
blocks: mov si,.list ; Set all blocks available
mov di,.avail
mov cx,20
rep movsw
.char: mov al,[bx] ; Get current character
inc bx
cmp al,'$' ; Are we at the end?
je .ok ; Then the string is accepted
mov cx,40 ; If not, check if block is available
mov di,.avail
repne scasb
test cx,cx ; This clears the carry flag
jz .out ; If zero, block is not available
dec di ; Zero out the block we found
mov [di],ch ; CH is guaranteed 0 here
xor di,1 ; Point at other character on block
mov [di],ch ; Zero out that one too.
jmp .char
.ok: stc
.out: ret
.list: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
.avail: db ' '
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Test code: run the subroutine on the given words
demo: mov bp,words
wrd: mov dx,[bp] ; Get word
test dx,dx ; End of words?
jz stop
mov ah,9 ; Print word
int 21h
mov bx,dx ; Run subroutine
call blocks
mov dx,yes ; Print yes or no depending on carry
jc print
mov dx,no
print: mov ah,9
int 21h
inc bp
inc bp
jmp wrd
stop: ret
section .data
yes: db ': Yes',13,10,'$'
no: db ': No',13,10,'$'
words: dw .a,.bark,.book,.treat,.cmn,.squad,.confs,0
.a: db 'A$'
.bark: db 'BARK$'
.book: db 'BOOK$'
.treat: db 'TREAT$'
.cmn: db 'COMMON$'
.squad: db 'SQUAD$'
.confs: db 'CONFUSE$'</syntaxhighlight>
 
{{out}}
 
<pre>A: Yes
BARK: Yes
BOOK: No
TREAT: Yes
COMMON: No
SQUAD: Yes
CONFUSE: Yes</pre>
 
=={{header|8th}}==
<syntaxhighlight lang="360asm">
\ ========================================================================================
\ You are given a collection of ABC blocks
\ There are twenty blocks with two letters on each block.
\ A complete alphabet is guaranteed amongst all sides of the blocks.
\
\ Write a function that takes a string (word) and determines whether
\ the word can be spelled with the given collection of blocks.
\
\ Rules:
\ 1. Once a letter on a block is used that block cannot be used again
\ 2. The function should be case-insensitive
\ 3. Show the output on this page for the following 7 words in the following example
\ can_make_word(???) where ??? is resp.:
\ "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"
\
\ NOTE:
\ to make the program readable for even n00bs, I have a comment at the end of each line.
\ The comments take the form of:
\ \ <stack> | <rstack>
\ in order to be able to follow exactly what the program does.
\ ========================================================================================
 
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] var, blks
["a", "AbBa", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"] var, chkwrds
 
needs stack/rstack
 
a:new var, paths \ Keeps the combinatory explosion of letter paths
var wrd
var success
var ix
 
: uni2char "" swap s:+ ;
: char2uni 0 s:@ nip ;
 
: rreset rstack st:clear drop ;
 
: addoneletter \ ix path -- \ ix path | letter
r@ \ ix path letter | letter
s:+ \ ix newpath | letter
paths @ \ ix newpath paths | letter
-rot \ paths ix newval | letter
a:! \ paths | letter
drop \ | letter
;
 
: oneletter \ letter -- \ letter
>r \ | letter
paths @ ' addoneletter a:each drop \ | letter
;
 
: addtwoletters \ ix path -- \ ix path | letter1 letter2 halflen
swap \ path ix | letter1 letter2 halflen
dup \ path ix ix | letter1 letter2 halflen
r@ \ path ix ix halflen | letter1 letter2 halflen
n:< \ path ix bool | letter1 letter2 halflen
if \ path ix | letter1 letter2 halflen
swap \ ix path | letter1 letter2 halflen
1 rpick \ ix path letter | letter1 letter2 halflen
else
swap \ ix path | letter1 letter2 halflen
2 rpick \ ix path letter | letter1 letter2 halflen
then
s:+ \ ix newpath | letter1 letter2 halflen
paths @ \ ix newpath paths | letter1 letter2 halflen
-rot \ paths ix newpath | letter1 letter2 halflen
a:! \ paths | letter1 letter2 halflen
drop \ | letter1 letter2 halflen
;
: twoletters \ letters -- \ letters
\ fetch the 2 letters
dup \ letters letters
1 s:lsub \ letters letter1
>r \ letters | letter1
1 s:rsub \ letter2 | letter1
>r \ | letter1 letter2
\ duplicate paths in itself
paths @ dup a:+ \ paths | letter1 letter2
\ halfway length of array
a:len \ paths len | letter1 letter2
2 / \ paths halflen | letter1 letter2
>r \ paths | letter1 letter2 halflen
\ add letters to paths
' addtwoletters a:each drop \ | letter1 letter2 halflen
rreset \
;
 
: chkletter \ letter -- letter \ letter
dup \ letter letter
wrd @ \ letter letter word
swap uni2char \ letter word letter
s:search \ letter word index
null? \ letter word index bool
nip \ letter word bool
if \ letter word
2drop \
"" \ letter
else \ letter word
drop \ letter
then \
;
 
: buildpaths \ ix blk -- \ ix blk
nip \ blk
' chkletter s:map \ resultletters
s:len \ resultletters len
dup \ resultletters len len
0 \ resultletters len len 0
n:= \ resultletters len bool
if \ resultletters len
\ This block contains no letters of current word
2drop \
;; \ exit word
then \ resultletters len
1 \ resultletters len 1
n:= \ resultletters bool
if \ resultletters
oneletter \
else \ resultletters
twoletters \
then
;
 
: chkokpath \ ix wrdch -- \ ix wrdch | path
swap \ wrdch ix | path
ix ! \ wrdch | path
r@ \ wrdch path | path
dup \ wrdch path path | path
"" \ wrdch path path "" | path
s:= \ wrdch path bool | path
if \ wrdch path | path
\ Path is empty - no match
2drop \ | path
break \ | path
;; \ | path
then
swap \ path wrdch | path
uni2char \ path wrdch | path
s:search \ path pos | path
null? \ path pos bool | path
if \ path pos | path
\ Letter not found in path - no match
2drop \ | path
break \ | path
else \ path pos | path
wrd @ \ path pos wrd | path
s:len \ path pos wrd len | path
nip \ path pos len | path
n:1- \ path pos cix | path
ix @ \ path pos cix ix | path
n:= \ path pos bool | path
if \ path pos | path
\ We have a match!
true success ! \ path pos | path
2drop \ | path
break \ | path
else \ path pos | path
1 \ path pos len | path
s:- \ restpath | path
rdrop >r \ | restpath
then
then
;
 
: chkpath \ ix path -- \ ix path
nip \ path
>r \ | path
wrd @ \ wrd | path
' chkokpath s:each \ | path
rdrop \
success @ \ success
if \
break \
then
;
: chkwrd \ ix wrd -- \ ix wrd
nip \ wrd
s:uc \ wrdupper
"Word=" . dup . \ wrdupper
wrd ! \
\ other word - clear paths
paths @ a:clear "" a:push drop \
\ create path tree for this word
blks @ ' buildpaths a:each drop \
\ check if word can be made from a path
false success ! \
paths @ ' chkpath a:each drop \
success @ \ success
"\t\t" . . cr \
;
 
: app:main
chkwrds @ ' chkwrd a:each drop \ check if word can be made
bye
;
</syntaxhighlight>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program problemABC64.s */
 
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ TRUE, 1
.equ FALSE, 0
 
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessTitre1: .asciz "Can_make_word: @ \n"
szMessTrue: .asciz "True.\n"
szMessFalse: .asciz "False.\n"
szCarriageReturn: .asciz "\n"
 
szTablBloc: .asciz "BO"
.asciz "XK"
.asciz "DQ"
.asciz "CP"
.asciz "NA"
.asciz "GT"
.asciz "RE"
.asciz "TG"
.asciz "QD"
.asciz "FS"
.asciz "JW"
.asciz "HU"
.asciz "VI"
.asciz "AN"
.asciz "OB"
.asciz "ER"
.asciz "FS"
.asciz "LY"
.asciz "PC"
.asciz "ZM"
.equ NBBLOC, (. - szTablBloc) / 3
szWord1: .asciz "A"
szWord2: .asciz "BARK"
szWord3: .asciz "BOOK"
szWord4: .asciz "TREAT"
szWord5: .asciz "COMMON"
szWord6: .asciz "SQUAD"
szWord7: .asciz "CONFUSE"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
qtabTopBloc: .skip 8 * NBBLOC
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszWord1
bl traitBlock // control word
 
ldr x0,qAdrszWord2
bl traitBlock // control word
ldr x0,qAdrszWord3
bl traitBlock // control word
ldr x0,qAdrszWord4
bl traitBlock // control word
ldr x0,qAdrszWord5
bl traitBlock // control word
ldr x0,qAdrszWord6
bl traitBlock // control word
ldr x0,qAdrszWord7
bl traitBlock // control word
 
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrszWord1: .quad szWord1
qAdrszWord2: .quad szWord2
qAdrszWord3: .quad szWord3
qAdrszWord4: .quad szWord4
qAdrszWord5: .quad szWord5
qAdrszWord6: .quad szWord6
qAdrszWord7: .quad szWord7
/******************************************************************/
/* traitement */
/******************************************************************/
/* x0 contains word */
traitBlock:
stp x1,lr,[sp,-16]! // save registres
mov x1,x0
ldr x0,qAdrszMessTitre1 // insertion word in message
bl strInsertAtCharInc
bl affichageMess // display title message
mov x0,x1
bl controlBlock // control
cmp x0,#TRUE // ok ?
bne 1f
ldr x0,qAdrszMessTrue // yes
bl affichageMess
b 100f
1: // no
ldr x0,qAdrszMessFalse
bl affichageMess
100:
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrszMessTitre1: .quad szMessTitre1
qAdrszMessFalse: .quad szMessFalse
qAdrszMessTrue: .quad szMessTrue
/******************************************************************/
/* control if letters are in block */
/******************************************************************/
/* x0 contains word */
controlBlock:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
mov x5,x0 // save word address
ldr x4,qAdrqtabTopBloc
ldr x6,qAdrszTablBloc
mov x2,#0
mov x3,#0
1: // init table top block used
str x3,[x4,x2,lsl #3]
add x2,x2,#1
cmp x2,#NBBLOC
blt 1b
mov x2,#0
2: // loop to load letters
ldrb w3,[x5,x2]
cbz w3,10f // end
mov x0,0xDF
and x3,x3,x0 // transform in capital letter
mov x8,#0
3: // begin loop control block
ldr x7,[x4,x8,lsl #3] // block already used ?
cbnz x7,5f // yes
add x9,x8,x8,lsl #1 // no -> index * 3
ldrb w7,[x6,x9] // first block letter
cmp w3,w7 // equal ?
beq 4f
add x9,x9,#1
ldrb w7,[x6,x9] // second block letter
cmp w3,w7 // equal ?
beq 4f
b 5f
4:
mov x7,#1 // top block
str x7,[x4,x8,lsl #3] // block used
add x2,x2,#1
b 2b // next letter
5:
add x8,x8,#1
cmp x8,#NBBLOC
blt 3b
mov x0,#FALSE // no letter find on block -> false
b 100f
10: // all letters are ok
mov x0,#TRUE
100:
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
qAdrqtabTopBloc: .quad qtabTopBloc
qAdrszTablBloc: .quad szTablBloc
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
{{Output}}
<pre>
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.
</pre>
=={{header|ABAP}}==
<syntaxhighlight lang="abap">
REPORT z_rosetta_abc.
 
" Type declaration for blocks of letters
TYPES: BEGIN OF block,
s1 TYPE char1,
s2 TYPE char1,
END OF block,
 
blocks_table TYPE STANDARD TABLE OF block.
 
DATA: blocks TYPE blocks_table.
 
CLASS word_maker DEFINITION.
PUBLIC SECTION.
CLASS-METHODS:
can_make_word
IMPORTING word TYPE string
letter_blocks TYPE blocks_table
RETURNING VALUE(found) TYPE abap_bool.
ENDCLASS.
 
CLASS word_maker IMPLEMENTATION.
METHOD can_make_word.
 
" Create a reader stream that reads 1 character at a time
DATA(reader) = NEW cl_abap_string_c_reader( word ).
 
DATA(blocks) = letter_blocks.
 
WHILE reader->data_available( ).
 
DATA(ch) = to_upper( reader->read( 1 ) ).
found = abap_false.
 
LOOP AT blocks REFERENCE INTO DATA(b).
IF ch = b->s1 OR ch = b->s2.
found = abap_true.
DELETE blocks INDEX sy-tabix.
EXIT. " the inner loop once a character is found
ENDIF.
ENDLOOP.
 
" If a character could not be found, stop looking further
IF found = abap_false.
RETURN.
ENDIF.
ENDWHILE.
 
ENDMETHOD.
ENDCLASS.
 
START-OF-SELECTION.
 
blocks = VALUE #( ( s1 = 'B' s2 = 'O' ) ( s1 = 'X' s2 = 'K' )
( s1 = 'D' s2 = 'Q' ) ( s1 = 'C' s2 = 'P' )
( s1 = 'N' s2 = 'A' ) ( s1 = 'G' s2 = 'T' )
( s1 = 'R' s2 = 'E' ) ( s1 = 'T' s2 = 'G' )
( s1 = 'Q' s2 = 'D' ) ( s1 = 'F' s2 = 'S' )
( s1 = 'J' s2 = 'W' ) ( s1 = 'H' s2 = 'U' )
( s1 = 'V' s2 = 'I' ) ( s1 = 'A' s2 = 'N' )
( s1 = 'O' s2 = 'B' ) ( s1 = 'E' s2 = 'R' )
( s1 = 'F' s2 = 'S' ) ( s1 = 'L' s2 = 'Y' )
( s1 = 'P' s2 = 'C' ) ( s1 = 'Z' s2 = 'M' )
).
 
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'A' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'BARK' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'BOOK' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'TREAT' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'COMMON' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'SQUAD' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'CONFUSE' letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
</syntaxhighlight>
{{out}}
<pre>
True
True
False
True
False
True
True
</pre>
 
=={{header|ABC}}==
<syntaxhighlight lang="ABC">HOW TO REPORT word can.be.made.with blocks:
FOR letter IN upper word:
IF NO block IN blocks HAS letter in block: FAIL
REMOVE block FROM blocks
SUCCEED
 
PUT {"BO";"XK";"DQ";"CP";"NA";"GT";"RE";"TG";"QD";"FS"} IN blocks
PUT {"JW";"HU";"VI";"AN";"OB";"ER";"FS";"LY";"PC";"ZM"} IN blocks2
FOR block IN blocks2: INSERT block IN blocks
 
PUT {"A";"BARK";"BOOK";"treat";"common";"Squad";"CoNfUsE"} IN words
 
FOR word IN words:
WRITE word, ": "
SELECT:
word can.be.made.with blocks: WRITE "yes"/
ELSE: WRITE "no"/</syntaxhighlight>
{{out}}
<pre>A: yes
BARK: yes
BOOK: no
CoNfUsE: yes
Squad: yes
common: no
treat: yes</pre>
 
=={{header|Action!}}==
<syntaxhighlight lang="action!">DEFINE COUNT="20"
CHAR ARRAY sideA="BXDCNGRTQFJHVAOEFLPZ"
CHAR ARRAY sideB="OKQPATEGDSWUINBRSYCM"
BYTE ARRAY used(COUNT)
 
BYTE FUNC ToUpper(BYTE c)
IF c>='a AND c<='z THEN
RETURN (c-'a+'A)
FI
RETURN (c)
 
BYTE FUNC CanBeUsed(CHAR c)
BYTE i
 
FOR i=0 TO COUNT-1
DO
IF used(i)=0 AND (sideA(i+1)=c OR sideB(i+1)=c) THEN
used(i)=1
RETURN (1)
FI
OD
RETURN (0)
 
BYTE FUNC Check(CHAR ARRAY s)
BYTE i
CHAR c
 
FOR i=0 TO COUNT-1
DO used(i)=0 OD
 
FOR i=1 TO s(0)
DO
c=ToUpper(s(i))
IF CanBeUsed(c)=0 THEN
RETURN (0)
FI
OD
RETURN (1)
 
PROC Test(CHAR ARRAY s)
Print(s) Print(": ")
IF Check(s) THEN
PrintE("can be made")
ELSE
PrintE("can not be made")
FI
RETURN
 
PROC Main()
Test("a")
Test("bARk")
Test("book")
Test("TReat")
Test("coMMon")
Test("SQuaD")
Test("CoNfUsE")
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/ABC_problem.png Screenshot from Atari 8-bit computer]
<pre>
a: can be made
bARk: can be made
book: can not be made
TReat: can be made
coMMon: can not be made
SQuaD: can be made
CoNfUsE: can be made
</pre>
 
=={{header|Acurity Architect}}==
Line 61 ⟶ 933:
Using #HASH-OFF
</pre>
<langsyntaxhighlight lang="acurity architect">
FUNCTION bCAN_MAKE_WORD(zWord: STRING): BOOLEAN
VAR sBlockCount: SHORT
Line 88 ⟶ 960:
RETURN OCCURS(zUsedBlocks, ",") = sWordLength
ENDFUNCTION
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 105 ⟶ 977:
</pre>
 
<langsyntaxhighlight lang="ada">with Ada.Characters.Handling;
use Ada.Characters.Handling;
 
Line 183 ⟶ 1,055:
end loop;
end Abc_Problem;
</syntaxhighlight>
</lang>
 
{{out}}
Line 198 ⟶ 1,070:
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.win32}}
<langsyntaxhighlight lang="algol68"># determine whether we can spell words with a set of blocks #
 
# construct the list of blocks #
Line 278 ⟶ 1,150:
 
)
</syntaxhighlight>
</lang>
Output:
<pre>
Line 291 ⟶ 1,163:
 
=={{header|ALGOL W}}==
<langsyntaxhighlight lang="algolw">% determine whether we can spell words with a set of blocks %
begin
% Returns true if we can spell the word using the blocks, %
Line 371 ⟶ 1,243:
testCanSpell( "confuse", 7 )
end
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 384 ⟶ 1,256:
 
=={{header|Apex}}==
<langsyntaxhighlight Javalang="java">static Boolean canMakeWord(List<String> src_blocks, String word) {
if (String.isEmpty(word)) {
return true;
Line 428 ⟶ 1,300:
System.debug('"COMMON": ' + canMakeWord(blocks, 'COMMON'));
System.debug('"SQuAd": ' + canMakeWord(blocks, 'SQuAd'));
System.debug('"CONFUSE": ' + canMakeWord(blocks, 'CONFUSE'));</langsyntaxhighlight>
{{out}}
<pre>"": true
Line 438 ⟶ 1,310:
"SQuAd": true
"CONFUSE": true</pre>
 
=={{header|APL}}==
{{works with|Dyalog APL|16.0}}
<syntaxhighlight lang="apl">abc←{{0=⍴⍵:1 ⋄ 0=⍴h←⊃⍵:0 ⋄ ∇(t←1↓⍵)~¨⊃h:1 ⋄ ∇(⊂1↓h),t}⍸¨↓⍵∘.∊⍺}</syntaxhighlight>
{{out}}
<pre> )COPY dfns ucase
b W←(≠∘' '⊆⊢)∘ucase¨'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM' 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE'
b∘abc¨W
1 1 0 1 0 1 1
</pre>
 
=={{header|AppleScript}}==
===Imperative===
 
<langsyntaxhighlight AppleScriptlang="applescript">set blocks to {"bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs", "jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}¬
"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}
 
canMakeWordWithBlocks("a", blocks)
Line 452 ⟶ 1,335:
 
on canMakeWordWithBlocks(theString, constBlocks)
copy constBlocks to theBlocks
if theString = "" then return true
set i to 1
repeat
if i > (count theBlocks) then exit repeat
if character 1 of theString is in item i of theBlocks then
set item i of theBlocks to missing value
set theBlocks to strings of theBlocks
if canMakeWordWithBlocks(rest of characters of theString as string, theBlocks) then
return true
end if
end if
set i to i + 1
end repeat
return false
end canMakeWordWithBlocks</syntaxhighlight>
----
An alternative version of the above, avoiding list-coercion and case vulnerabilities and unnecessary extra lists and substrings. Also observing the task's third rule!
 
<syntaxhighlight lang="applescript">on canMakeWordWithBlocks(theString, theBlocks)
set stringLen to (count theString)
copy theBlocks to theBlocks
script o
on cmw(c, theBlocks)
set i to 1
repeat until (i > (count theBlocks))
if (character c of theString is in item i of theBlocks) then
if (c = stringLen) then return true
set item i of theBlocks to missing value
set theBlocks to text of theBlocks
if (cmw(c + 1, theBlocks)) then return true
end if
set i to i + 1
end repeat
return false
end cmw
end script
ignoring case -- Make the default case insensitivity explicit.
return ((theString = "") or (o's cmw(1, theBlocks)))
end ignoring
end canMakeWordWithBlocks
 
</lang>
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
 
on task()
set blocks to {"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", ¬
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"}
set output to {}
repeat with testWord in {"a", "bark", "book", "treat", "common", "squad", "confuse"}
set end of output to "Can make “" & testWord & "”: " & ¬
canMakeWordWithBlocks(testWord's contents, blocks)
end repeat
return join(output, linefeed)
end task
 
task()</syntaxhighlight>
 
{{output}}
<syntaxhighlight lang="applescript">"Can make “a”: true
Can make “bark”: true
Can make “book”: false
Can make “treat”: true
Can make “common”: false
Can make “squad”: true
Can make “confuse”: true"</syntaxhighlight>
----
 
===Functional===
<syntaxhighlight lang="applescript">use AppleScript version "2.4"
use framework "Foundation"
 
----------------------- ABC Problem -----------------------
 
-- spellWith :: [String] -> [Char] -> [[String]]
on spellWith(blocks, cs)
if 0 < length of cs then
set x to item 1 of cs
script go
on |λ|(b)
if b contains x then
map(my cons(b), ¬
spellWith(|delete|(b, blocks), rest of cs))
else
{}
end if
end |λ|
end script
concatMap(go, blocks)
else
{{}}
end if
end spellWith
 
 
-------------------------- TEST ---------------------------
on run
set blocks to ¬
words of "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
script test
on |λ|(w)
justifyRight(9, space, quoted("'", w)) & " -> " & ¬
({} ≠ spellWith(blocks, characters of toUpper(w)))
end |λ|
end script
unlines(map(test, ¬
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]))
end run
 
 
-------------------- GENERIC FUNCTIONS --------------------
 
-- Just :: a -> Maybe a
on Just(x)
-- Constructor for an inhabited Maybe (option type) value.
-- Wrapper containing the result of a computation.
{type:"Maybe", Nothing:false, Just:x}
end Just
 
 
-- Nothing :: Maybe a
on Nothing()
-- Constructor for an empty Maybe (option type) value.
-- Empty wrapper returned where a computation is not possible.
{type:"Maybe", Nothing:true}
end Nothing
 
 
-- elemIndex :: Eq a => a -> [a] -> Maybe Int
on elemIndex(x, xs)
set lng to length of xs
repeat with i from 1 to lng
if x = (item i of xs) then return Just(i)
end repeat
return Nothing()
end elemIndex
 
 
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & (|λ|(item i of xs, i, xs))
end repeat
end tell
return acc
end concatMap
 
 
-- cons :: a -> [a] -> [a]
on cons(x)
script
on |λ|(xs)
{x} & xs
end |λ|
end script
end cons
 
 
-- delete :: Eq a => a -> [a] -> [a]
on |delete|(x, xs)
set mbIndex to elemIndex(x, xs)
set lng to length of xs
if Nothing of mbIndex then
xs
else
if 1 < lng then
set i to Just of mbIndex
if 1 = i then
items 2 thru -1 of xs
else if lng = i then
items 1 thru -2 of xs
else
tell xs to items 1 thru (i - 1) & items (i + 1) thru -1
end if
else
{}
end if
end if
end |delete|
 
 
-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller, strText)
if n > length of strText then
text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
else
strText
end if
end justifyRight
 
 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
 
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
 
 
-- quoted :: Char -> String -> String
on quoted(c, s)
-- string flanked on both sides
-- by a specified quote character.
c & s & c
end quoted
 
 
-- replicate :: Int -> String -> String
on replicate(n, s)
set out to ""
if n < 1 then return out
set dbl to s
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
 
 
-- toUpper :: String -> String
on toUpper(str)
set ca to current application
((ca's NSString's stringWithString:(str))'s ¬
uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toUpper
 
 
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set s to xs as text
set my text item delimiters to dlm
s
end unlines</syntaxhighlight>
{{Out}}
<pre> '' -> true
'A' -> true
'BARK' -> true
'BoOK' -> false
'TrEAT' -> true
'COmMoN' -> false
'SQUAD' -> true
'conFUsE' -> true</pre>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program problemABC.s */
 
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ TRUE, 1
.equ FALSE, 0
 
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessTitre1: .asciz "Can_make_word: @ \n"
szMessTrue: .asciz "True.\n"
szMessFalse: .asciz "False.\n"
szCarriageReturn: .asciz "\n"
 
szTablBloc: .asciz "BO"
.asciz "XK"
.asciz "DQ"
.asciz "CP"
.asciz "NA"
.asciz "GT"
.asciz "RE"
.asciz "TG"
.asciz "QD"
.asciz "FS"
.asciz "JW"
.asciz "HU"
.asciz "VI"
.asciz "AN"
.asciz "OB"
.asciz "ER"
.asciz "FS"
.asciz "LY"
.asciz "PC"
.asciz "ZM"
.equ NBBLOC, (. - szTablBloc) / 3
szWord1: .asciz "A"
szWord2: .asciz "BARK"
szWord3: .asciz "BOOK"
szWord4: .asciz "TREAT"
szWord5: .asciz "COMMON"
szWord6: .asciz "SQUAD"
szWord7: .asciz "CONFUSE"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
.align 4
itabTopBloc: .skip 4 * NBBLOC
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszWord1
bl traitBlock @ control word
 
ldr r0,iAdrszWord2
bl traitBlock @ control word
ldr r0,iAdrszWord3
bl traitBlock @ control word
ldr r0,iAdrszWord4
bl traitBlock @ control word
ldr r0,iAdrszWord5
bl traitBlock @ control word
ldr r0,iAdrszWord6
bl traitBlock @ control word
ldr r0,iAdrszWord7
bl traitBlock @ control word
 
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrszWord1: .int szWord1
iAdrszWord2: .int szWord2
iAdrszWord3: .int szWord3
iAdrszWord4: .int szWord4
iAdrszWord5: .int szWord5
iAdrszWord6: .int szWord6
iAdrszWord7: .int szWord7
/******************************************************************/
/* traitement */
/******************************************************************/
/* r0 contains word */
traitBlock:
push {r1,lr} @ save registers
mov r1,r0
ldr r0,iAdrszMessTitre1 @ insertion word in message
bl strInsertAtCharInc
bl affichageMess @ display title message
mov r0,r1
bl controlBlock @ control
cmp r0,#TRUE @ ok ?
bne 1f
ldr r0,iAdrszMessTrue @ yes
bl affichageMess
b 100f
1: @ no
ldr r0,iAdrszMessFalse
bl affichageMess
100:
pop {r1,lr}
bx lr @ return
iAdrszMessTitre1: .int szMessTitre1
iAdrszMessFalse: .int szMessFalse
iAdrszMessTrue: .int szMessTrue
/******************************************************************/
/* control if letters are in block */
/******************************************************************/
/* r0 contains word */
controlBlock:
push {r1-r9,lr} @ save registers
mov r5,r0 @ save word address
ldr r4,iAdritabTopBloc
ldr r6,iAdrszTablBloc
mov r2,#0
mov r3,#0
1: @ init table top block used
str r3,[r4,r2,lsl #2]
add r2,r2,#1
cmp r2,#NBBLOC
blt 1b
mov r2,#0
2: @ loop to load letters
ldrb r3,[r5,r2]
cmp r3,#0
beq 10f @ end
and r3,r3,#0xDF @ transform in capital letter
mov r8,#0
3: @ begin loop control block
ldr r7,[r4,r8,lsl #2] @ block already used ?
cmp r7,#0
bne 5f @ yes
add r9,r8,r8,lsl #1 @ no -> index * 3
ldrb r7,[r6,r9] @ first block letter
cmp r3,r7 @ equal ?
beq 4f
add r9,r9,#1
ldrb r7,[r6,r9] @ second block letter
cmp r3,r7 @ equal ?
beq 4f
b 5f
4:
mov r7,#1 @ top block
str r7,[r4,r8,lsl #2] @ block used
add r2,r2,#1
b 2b @ next letter
5:
add r8,r8,#1
cmp r8,#NBBLOC
blt 3b
mov r0,#FALSE @ no letter find on block -> false
b 100f
10: @ all letters are ok
mov r0,#TRUE
100:
pop {r1-r9,lr}
bx lr @ return
iAdritabTopBloc: .int itabTopBloc
iAdrszTablBloc: .int szTablBloc
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
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.
</pre>
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">blocks: map [
[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]
] => [ join map & => [to :string &]]
 
charInBlock: function [ch,bl][
loop.with:'i bl 'b ->
if contains? b upper ch [
return i
]
return ø
]
 
canMakeWord?: function [wrd][
ref: new blocks
loop split wrd 'chr [
cib: charInBlock chr ref
if? cib = ø [ return false ]
else [ ref: remove ref .index cib ]
]
return true
]
 
loop ["A" "BaRk" "bOoK" "tReAt" "CoMmOn" "SqUaD" "cONfUsE"] 'wrd
-> print [wrd "=>" canMakeWord? wrd]</syntaxhighlight>
{{Out}}
<pre>A => true
BaRk => true
bOoK => false
tReAt => true
CoMmOn => false
SqUaD => true
cONfUsE => true</pre>
 
=={{header|Astro}}==
<syntaxhighlight lang="python">fun abc(s, ls):
if ls.isempty:
return true
for i in indices(list) where s[end] in list[i]:
return abc(s[:end-1], remove!(copy(list), at: i))
false
 
let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
let ls = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS", "JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
 
for s in test:
print "($|>8|{s} ${abc(s, list)})"</syntaxhighlight>
 
=={{header|AutoHotkey}}==
 
'''Function'''
<langsyntaxhighlight lang="autohotkey">isWordPossible(blocks, word){
o := {}
loop, parse, blocks, `n, `r
Line 496 ⟶ 1,897:
added := 1
}
}</langsyntaxhighlight>
 
'''Test Input''' (as per question)
<langsyntaxhighlight lang="autohotkey">blocks := "
(
BO
Line 536 ⟶ 1,937:
loop, parse, wordlist, `n
out .= A_LoopField " - " isWordPossible(blocks, A_LoopField) "`n"
msgbox % out</langsyntaxhighlight>
 
{{out}}
Line 547 ⟶ 1,948:
CONFUSE - 1</pre>
 
=={{header|Batch FileAWK}}==
Here are 2 slightly different versions:
<lang dos>
<pre>
@echo off
#!/usr/bin/awk -f
::abc.bat
# tested with mawk 1.3.3 on Raspberry Pi 3
::
# also GNU awk 3.1.5, busybox 1.21.1 and 1.27.1 on AMD Sempron 2800+
::Batch file to evaluate if a given string can be represented with a set of
#
::20 2-faced blocks.
function setblocks() {
::
# key to the algorithm is the representation of a block
# each block is represented by 4 characters in the string "blocks"
# for example, the "BO" block becomes "-BO-"
#
blocks="-BO--XK--DQ--CP--NA--GT--RE--TG--QD--FS--JW--HU--VI--AN--OB--ER--FS--LY--PC--ZM-"
true=1
false=0
}
function found(letter){
#
# the function "found" scans for the letter on the top of a block
# using the pattern "-B", for example, to find a "B",
# returning "true" (or 1) if found
# if not found on the top, look on the bottoms using the pattern "B-"
# again returning "true" if found
# if the letter is found on either top or bottom, the 4 character block is set to "----"
# so that block is unavailable
# finally, if no available copy of letter is found,
# the function returns "false" (0)
position= index(blocks,"-" letter)
if (position > 0)
{
blocks = substr(blocks,1,position-1) "----" substr(blocks,position+4)
return true
}
position = index(blocks,letter "-")
if (position > 0)
{blocks = substr(blocks,1,position-3) "----" substr(blocks,position+2)
return true
}
return false
}
# awk's BEGIN statement allows for initialization before processing input;
# in this case, initializing the string "blocks"
#
BEGIN{
setblocks()
}
# in awk, the input record is contained in the string variable "$0"
# the main process checks each letter in turn to see if it is on a usable block,
# summing the values returned by "found"
# if the sum equals the number of input characters the word can be spelled with the blocks
# otherwise it is not possible
#
{
nchars=length($0)
possible=false
for (i=1;i<=nchars;i++){
possible=possible + found(substr($0,i,1))
}
if (possible==nchars) print $0 " is possible"
else print $0 " is not possible"
setblocks()
}
</pre>
-------------------- and -----------------
<pre>
#!/usr/bin/awk -f
# tested with mawk 1.3.3 on Raspberry Pi 3
# also GNU awk 3.1.5, busybox 1.21.1 and 1.27.1 on AMD Sempron 2800+
#
function setblocks() {
#
# key to the algorithm is the representation of the blocks
# each block is represented by 1 character in the string "tops"
# and by 1 character in the string "bottoms"
#
tops="BXDCNGRTQFJHVAOEFLPZ"
bottoms="OKQPATEGDSWUINBRSYCM"
true=1
false=0
}
function found(letter){
#
# the function "found" scans first the string "tops" for a letter and
# then the string "bottoms" if the letter is not in "tops"
# if the letter is found, it marks "tops" and "bottoms" to show
# the block is unavailable by changing the letters on the block to "-"
# and returns "true" (1); if the letter is not found
# the function returns "false" (0)
#
position= index(tops,letter)
if (position > 0)
{
tops = substr(tops,1,position-1) "-" substr(tops,position+1)
bottoms = substr(bottoms,1,position-1) "-" substr(bottoms,position+1)
return true
}
position = index(bottoms,letter)
if (position > 0)
{bottoms = substr(bottoms,1,position-1) "-" substr(bottoms,position+1)
tops = substr(tops,1,position-1) "-" substr(tops,position+1)
return true
}
return false
}
# awk's BEGIN statement allows for initialization before processing input;
# in this case, initializing the string "blocks"
#
BEGIN{
setblocks()
}
# in awk, the input record is contained in the string variable "$0"
# the main process checks each letter in turn to see if it is on a usable block,
# summing the values returned by "found"
# if the sum equals the number of input characters the word can be spelled with the blocks
# otherwise it is not possible
#
{
nchars=length($0)
possible=false
for (i=1;i<=nchars;i++){
possible=possible + found(substr($0,i,1))
}
if (possible==nchars) print $0 " is possible"
else print $0 " is not possible"
setblocks()
}
</pre>
{{out}}
<pre>
pi@raspberrypi:~/Documents/rosettacode $ ./abcProblem.awk
A
A is possible
BARK
BARK is possible
BOOK
BOOK is not possible
TREAT
TREAT is possible
COMMON
COMMON is not possible
SQUAD
SQUAD is possible
CONFUSE
CONFUSE is possible
^C
pi@raspberrypi:~/Documents/rosettacode $
</pre>
 
=={{header|BaCon}}==
::Check if a string was provided
<syntaxhighlight lang="qbasic">CONST info$ = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
if "%1"=="" goto ERROR
 
DATA "A", "BARK", "BOOK", "TREAT", "Common", "Squad", "Confuse"
::Define blocks. Separate blocks by ':', and terminat with '::'
set "FACES=BO:XK:DQ:CP:NA:GT:RE:TG:QD:FS:JW:HU:VI:AN:OB:ER:FS:LY:PC:ZM::"
set INPUT=%1
set "COUNTER=0"
 
WHILE TRUE
::The main loop steps through the input string, checking if an available
READ word$
::block exists for each character
:LOOP_MAIN
 
IF NOT(LEN(word$)) THEN BREAK
::Get character, increase counter, and test if there are still characters
call set "char=%%INPUT:~%COUNTER%,1%%"
set /a "COUNTER+=1"
if "%CHAR%"=="" goto LOOP_MAIN_END
 
block$ = info$
set "OFFSET=0"
:LOOP_2
 
::Readcount in two characters= AMOUNT(one block$)
call set "BLOCK=%%FACES%:~%OFFSET%,2%%"
 
FOR y = 1 TO LEN(word$)
::Test if the all blocks were checked. If so, no match was found
FOR x = 1 TO AMOUNT(block$)
if "%BLOCK%"==":" goto FAIL
IF TALLY(TOKEN$(block$, x), MID$(UCASE$(word$), y, 1)) THEN
block$ = DEL$(block$, x)
BREAK
END IF
NEXT
NEXT
 
PRINT word$, IIF$(LEN(word$) = count-AMOUNT(block$), "True", "False") FORMAT "%-10s: %s\n"
::Test if current input string character is in the current block
WEND</syntaxhighlight>
if /i "%BLOCK:~0,1%"=="%CHAR%" goto FOUND
{{out}}
if /i "%BLOCK:~1,1%"=="%CHAR%" goto FOUND
<pre>
 
A ::Increase offset to point to the next: blockTrue
BARK set /a "OFFSET+=3": True
BOOK : False
 
TREAT : True
goto LOOP_2
Common : False
:LOOP_2_END
Squad : True
 
Confuse : True
::If found, blank out the block used
</pre>
:FOUND
call set "FACES=%%FACES:%BLOCK%:= :%%"
 
goto LOOP_MAIN
:LOOP_MAIN_END
 
echo %0: It is possible to write the '%INPUT%' with my blocks.
goto END
 
:FAIL
echo %0: It is NOT possible to write the '%INPUT%' with my blocks.
goto END
 
:ERROR
echo %0: Please enter a string to evaluate
echo.
 
:END
</lang>
 
=={{header|BASIC}}==
Works with:VB-DOS, QB64, QBasic, QuickBASIC
<langsyntaxhighlight lang="qbasic">
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' ABC_Problem '
Line 741 ⟶ 2,260:
 
END FUNCTION
</syntaxhighlight>
</lang>
 
==={{header|Commodore BASIC}}===
{{trans|Sinclair ZX-81 BASIC}}
<syntaxhighlight lang="basic">10 W$ = "A" : GOSUB 100
20 W$ = "BARK" : GOSUB 100
30 W$ = "BOOK" : GOSUB 100
40 W$ = "TREAT" : GOSUB 100
50 W$ = "COMMON" : GOSUB 100
60 W$ = "SQUAD" : GOSUB 100
70 W$ = "CONFUSE" : GOSUB 100
80 END
90 REM ********************************
100 B$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
110 FOR I=1 TO LEN(W$)
120 : BL = LEN(B$)
130 : FOR J=1 TO BL STEP 2
140 : C$=MID$(B$,J,1): D$=MID$(B$,J+1,1)
150 : X$=MID$(W$,I,1)
160 : IF C$<>X$ AND D$<>X$ THEN GOTO 190
170 : B$ = LEFT$(B$,J-1)+RIGHT$(B$,BL-J-1)
180 : GOTO 210
190 : NEXT J
200 : IF J>BL-1 THEN GOTO 240
210 NEXT I
220 PRINT W$" -> YES"
230 RETURN
240 PRINT W$" -> NO"
250 RETURN</syntaxhighlight>
 
{{out}}
<pre>A -> YES
BARK -> YES
BOOK -> NO
TREAT -> YES
COMMON -> NO
SQUAD -> YES
CONFUSE -> YES</pre>
 
The above greedy algorithm works on the sample data, but fails on other data - for example, it will declare that you cannot spell the word ABBA using the blocks (AB),(AB),(AC),(AC), because it will use the two AB blocks for the first two letters "AB", leaving none for the second "B". This recursive solution is more thorough about confirming negatives and handles that case correctly:
 
<syntaxhighlight lang="basic">100 REM RECURSIVE SOLUTION
110 MS=100:REM MAX STACK DEPTH
120 DIM BL$(MS):REM BLOCKS LEFT
130 DIM W$(MS):REM REMAINING LETTERS
140 DIM I(MS):REM LOOP CONTROL VARIABLE
150 DIM RV(MS):REM RETURN VALUE
160 SP=-1:REM STACK POINTER
170 READ BL$
180 PRINT "USING BLOCKS: "
190 FOR I=1 TO LEN(BL$) STEP 2
200 : PRINT"("MID$(BL$,I,2)")";
210 NEXT I
220 PRINT CHR$(13)
230 READ W$
240 IF W$="" THEN 320
250 PRINT W$;"->";
260 SP=SP+1:BL$(SP)=BL$:W$(SP)=W$
270 GOSUB 350
280 IF RV(SP) THEN PRINT "YES": GOTO 300
290 PRINT "NO"
300 SP=SP-1
310 GOTO 230
320 READ BL$
330 IF BL$ THEN PRINT:GOTO 180
340 END
350 IF LEN(W$(SP))=0 THEN RV(SP)=-1:RETURN
360 I(SP)=1
370 IF I(SP)>=LEN(BL$(SP)) THEN RV(SP)=0:RETURN
380 IF MID$(BL$(SP),I(SP),1) = LEFT$(W$(SP),1) THEN 410
390 IF MID$(BL$(SP),I(SP)+1,1) = LEFT$(W$(SP),1) THEN 410
400 GOTO 450
410 W$(SP+1)=MID$(W$(SP),2)
420 BL$(SP+1)=LEFT$(BL$(SP),I(SP)-1)+MID$(BL$(SP),I(SP)+2)
430 SP=SP+1:GOSUB 350:SP=SP-1
440 IF RV(SP+1) THEN RV(SP)=-1:RETURN
450 I(SP)=I(SP)+2:GOTO 370
460 DATA BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM
470 DATA A, BORK, BOOK, TREAT, COMMON, SQUAD, CONFUSE, ""
480 DATA ABABACAC,ABBA,""
490 DATA ""</syntaxhighlight>
 
{{Out}}
<pre>USING BLOCKS:
(BO)(XK)(DQ)(CP)(NA)(GT)(RE)(TG)(QD)(FS)
(JW)(HU)(VI)(AN)(OB)(ER)(FS)(LY)(PC)(ZM)
 
A->YES
BORK->YES
BOOK->NO
TREAT->YES
COMMON->NO
SQUAD->YES
CONFUSE->YES
 
USING BLOCKS:
(AB)(AB)(AC)(AC)
 
ABBA->YES</pre>
 
==={{header|Sinclair ZX81 BASIC}}===
Works with 1k of RAM. A nice unstructured algorithm. Unfortunately the requirement that it be case-insensitive is moot, because the ZX81 does not support lower-case letters.
<syntaxhighlight lang="basic"> 10 LET B$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
20 INPUT W$
30 FOR I=1 TO LEN W$
40 FOR J=1 TO LEN B$ STEP 2
50 IF B$(J)<>W$(I) AND B$(J+1)<>W$(I) THEN GOTO 100
60 LET B$=B$( TO J-1)+B$(J+2 TO )
70 NEXT I
80 PRINT "YES"
90 STOP
100 NEXT J
110 PRINT "NO"</syntaxhighlight>
{{in}}
<pre>A</pre>
{{out}}
<pre>YES</pre>
{{in}}
<pre>BARK</pre>
{{out}}
<pre>YES</pre>
{{in}}
<pre>BOOK</pre>
{{out}}
<pre>NO</pre>
{{in}}
<pre>TREAT</pre>
{{out}}
<pre>YES</pre>
{{in}}
<pre>COMMON</pre>
{{out}}
<pre>NO</pre>
{{in}}
<pre>SQUAD</pre>
{{out}}
<pre>YES</pre>
{{in}}
<pre>CONFUSE</pre>
{{out}}
<pre>YES</pre>
 
=={{header|BASIC256}}==
{{trans|Run BASIC}}
<syntaxhighlight lang="vb">arraybase 1
blocks$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
makeWord$ = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse"
b = int((length(blocks$) /3) + 1)
dim blk$(b)
 
for i = 1 to length(makeWord$)
wrd$ = word$(makeWord$,i,",")
dim hit(b)
n = 0
if wrd$ = "" then exit for
for k = 1 to length(wrd$)
w$ = upper(mid(wrd$,k,1))
for j = 1 to b
if hit[j] = 0 then
if w$ = left(word$(blocks$,j,","),1) or w$ = right(word$(blocks$,j,","),1) then
hit[j] = 1
n += 1
exit for
end if
end if
next j
next k
print wrd$; chr(9);
if n = length(wrd$) then print " True" else print " False"
next i
end
 
function word$(sr$, wn, delim$)
j = wn
if j = 0 then j += 1
res$ = "" : s$ = sr$ : d$ = delim$
if d$ = "" then d$ = " "
sd = length(d$) : sl = length(s$)
while true
n = instr(s$,d$) : j -= 1
if j = 0 then
if n = 0 then res$ = s$ else res$ = mid(s$,1,n-1)
return res$
end if
if n = 0 then return res$
if n = sl - sd then res$ = "" : return res$
sl2 = sl-n : s$ = mid(s$,n+1,sl2) : sl = sl2
end while
return res$
end function</syntaxhighlight>
{{out}}
<pre>Same as Run BASIC entry.</pre>
 
=={{header|Batch File}}==
<syntaxhighlight lang="dos">
@echo off
::abc.bat
::
::Batch file to evaluate if a given string can be represented with a set of
::20 2-faced blocks.
::
 
::Check if a string was provided
if "%1"=="" goto ERROR
 
::Define blocks. Separate blocks by ':', and terminat with '::'
set "FACES=BO:XK:DQ:CP:NA:GT:RE:TG:QD:FS:JW:HU:VI:AN:OB:ER:FS:LY:PC:ZM::"
set INPUT=%1
set "COUNTER=0"
 
::The main loop steps through the input string, checking if an available
::block exists for each character
:LOOP_MAIN
 
::Get character, increase counter, and test if there are still characters
call set "char=%%INPUT:~%COUNTER%,1%%"
set /a "COUNTER+=1"
if "%CHAR%"=="" goto LOOP_MAIN_END
 
set "OFFSET=0"
:LOOP_2
 
::Read in two characters (one block)
call set "BLOCK=%%FACES%:~%OFFSET%,2%%"
 
::Test if the all blocks were checked. If so, no match was found
if "%BLOCK%"==":" goto FAIL
 
::Test if current input string character is in the current block
if /i "%BLOCK:~0,1%"=="%CHAR%" goto FOUND
if /i "%BLOCK:~1,1%"=="%CHAR%" goto FOUND
 
::Increase offset to point to the next block
set /a "OFFSET+=3"
 
goto LOOP_2
:LOOP_2_END
 
::If found, blank out the block used
:FOUND
call set "FACES=%%FACES:%BLOCK%:= :%%"
 
goto LOOP_MAIN
:LOOP_MAIN_END
 
echo %0: It is possible to write the '%INPUT%' with my blocks.
goto END
 
:FAIL
echo %0: It is NOT possible to write the '%INPUT%' with my blocks.
goto END
 
:ERROR
echo %0: Please enter a string to evaluate
echo.
 
:END
</syntaxhighlight>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> BLOCKS$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
PROCcan_make_word("A")
PROCcan_make_word("BARK")
Line 766 ⟶ 2,542:
ENDWHILE
IF word$>"" PRINT "False" ELSE PRINT "True"
ENDPROC</langsyntaxhighlight>
 
{{out}}
Line 777 ⟶ 2,553:
Confuse -> True
</pre>
 
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
 
let canMakeWord(word) = valof
$( let blocks = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
let avl = vec 40/BYTESPERWORD
for i=0 to 39 do avl%i := blocks%(i+1)
for i=1 to word%0
$( for j=0 to 39
$( let ch = word%i
// make letter uppercase
if 'a' <= ch <= 'z' then ch := ch - 32
if ch = avl%j then
$( // this block is no longer available
avl%j := 0
avl%(j neqv 1) := 0
// but we did find a block
goto next
$)
$)
resultis false // no block found
next: loop
$)
resultis true
$)
 
let show(word) be
writef("%S: %S*N", word, canMakeWord(word) -> "yes", "no")
 
let start() be
$( show("A")
show("BARK")
show("book")
show("Treat")
show("CoMmOn")
show("SQUAD")
show("CONFUSE")
$)</syntaxhighlight>
{{out}}
<pre>A: yes
BARK: yes
book: no
Treat: yes
CoMmOn: no
SQUAD: yes
CONFUSE: yes</pre>
 
=={{header|BQN}}==
<syntaxhighlight lang="bqn">ABC ← {
Matches ← ⊑⊸(⊑∘∊¨)˜ /⊣ # blocks matching current letter
Others ← <˘∘⍉∘(»⊸≥∨`)∘(≡⌜)/¨<∘⊣ # blocks without current matches
𝕨(×∘≠∘⊢ ◶ ⟨1˙, # if the word is empty, it can be made
Matches(×∘≠∘⊣ ◶ ⟨0˙, # if no matching blocks, it cannot
∨´(𝕨 Others⊣) 𝕊¨ 1<∘↓⊢ # otherwise, remove block and try remaining letters
⟩)⊢
⟩) (⊢-32×1="a{"⍋⊢)𝕩
}
 
blocks←⟨"BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"⟩
 
words←⟨"A","bark","BOOK","TrEaT","Common","Squad","Confuse"⟩
 
> {(<𝕩) ∾ blocks ABC 𝕩}¨ words</syntaxhighlight>
{{out}}
<pre>┌─
╵ "A" 1
"bark" 1
"BOOK" 0
"TrEaT" 1
"Common" 0
"Squad" 1
"Confuse" 1
┘</pre>
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat">(
( can-make-word
= ABC blocks
Line 826 ⟶ 2,677:
& can-make-word'SQUAD
& can-make-word'CONFUSE
);</langsyntaxhighlight>
{{out}}
<pre>A yes
Line 838 ⟶ 2,689:
=={{header|C}}==
Recursive solution. Empty string returns true.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <ctype.h>
 
Line 878 ⟶ 2,729:
 
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 891 ⟶ 2,742:
</pre>
 
=={{header|C sharp|C#}}==
 
=={{header|C++}}==
Uses C++11. Build with g++-4.7 -Wall -std=c++0x abc.cpp
<lang cpp>#include <iostream>
#include <vector>
#include <string>
#include <set>
#include <cctype>
 
 
typedef std::pair<char,char> item_t;
typedef std::vector<item_t> list_t;
 
bool 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();
}
 
 
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 (const std::string& w : words) {
std::cout << w << ": " << std::boolalpha << can_make_word(w,vals) << ".\n";
}
 
}</lang>
 
{{out}}
<pre>A: true.
BARK: true.
BOOK: false.
TREAT: true.
COMMON: false.
SQUAD: true.
CONFUSE: true.
</pre>
 
=={{header|C sharp}}==
===Regex===
This Method uses regular expressions to do the checking. Given that n = length of blocks string and
m = length of word string, then CheckWord's time complexity comes out to about m*(n - (m-1)/2).
<langsyntaxhighlight lang="csharp">using System;
using System.IO;
// Needed for the method.
Line 976 ⟶ 2,776:
return true;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 988 ⟶ 2,788:
</pre>
'''Unoptimized'''
<langsyntaxhighlight lang="csharp">using System.Collections.Generic;
using System.Linq;
 
Line 1,070 ⟶ 2,870:
}
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,080 ⟶ 2,880:
SQUAD :True
CONFUSE :True</pre>
 
=={{header|C++}}==
{{Works with|C++11}}
Build with:
<syntaxhighlight lang="sh">g++-4.7 -Wall -std=c++0x abc.cpp</syntaxhighlight>
<syntaxhighlight lang="cpp">#include <iostream>
#include <vector>
#include <string>
#include <set>
#include <cctype>
 
typedef std::pair<char,char> item_t;
typedef std::vector<item_t> list_t;
 
bool 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();
}
 
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 (const std::string& w : words) {
std::cout << w << ": " << std::boolalpha << can_make_word(w,vals) << ".\n";
}
}</syntaxhighlight>
 
{{out}}
<pre>A: true.
BARK: true.
BOOK: false.
TREAT: true.
COMMON: false.
SQUAD: true.
CONFUSE: true.
</pre>
 
=={{header|Ceylon}}==
Line 1,086 ⟶ 2,935:
<b>module.ceylon</b>
 
<langsyntaxhighlight lang="ceylon">
module rosetta.abc "1.0.0" {}
</syntaxhighlight>
</lang>
 
<b>run.ceylon</b>
 
<langsyntaxhighlight lang="ceylon">
shared void run() {
printAndCanMakeWord("A", blocks);
Line 1,167 ⟶ 3,016:
myRemainingLetterIndexes)
else false;
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,182 ⟶ 3,031:
=={{header|Clojure}}==
A translation of the Haskell solution.
<langsyntaxhighlight lang="clojure">
(def blocks
(-> "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM" (.split " ") vec))
Line 1,203 ⟶ 3,052:
(doseq [word ["A" "BARK" "Book" "treat" "COMMON" "SQUAD" "CONFUSE"]]
(->> word .toUpperCase (abc blocks) first (printf "%s: %b\n" word)))</langsyntaxhighlight>
 
{{out}}
Line 1,213 ⟶ 3,062:
SQUAD: true
CONFUSE: true</pre>
 
=={{header|CLU}}==
<syntaxhighlight lang="clu">ucase = proc (s: string) returns (string)
rslt: array[char] := array[char]$predict(1,string$size(s))
for c: char in string$chars(s) do
if c>='a' & c<='z' then
c := char$i2c(char$c2i(c) - 32)
end
array[char]$addh(rslt,c)
end
return(string$ac2s(rslt))
end ucase
 
abc = proc (s: string) returns (bool)
own collection: sequence[string] := sequence[string]$
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
blocks: array[string] := sequence[string]$s2a(collection)
for c: char in string$chars(ucase(s)) do
begin
for i: int in array[string]$indexes(blocks) do
if string$indexc(c, blocks[i]) ~= 0 then
blocks[i] := ""
exit found
end
end
return(false)
end
except when found: end
end
return(true)
end abc
 
start_up = proc ()
po: stream := stream$primary_output()
words: sequence[string] := sequence[string]$
["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"]
for word: string in sequence[string]$elements(words) do
stream$puts(po, word || ": ")
if abc(word) then stream$putl(po, "yes")
else stream$putl(po, "no")
end
end
end start_up</syntaxhighlight>
{{out}}
<pre>A: yes
BARK: yes
BOOK: no
TREAT: yes
COMMON: no
SQUAD: yes
CONFUSE: yes</pre>
 
=={{header|CoffeeScript}}==
<langsyntaxhighlight CoffeeScriptlang="coffeescript">blockList = [ 'BO', 'XK', 'DQ', 'CP', 'NA', 'GT', 'RE', 'TG', 'QD', 'FS', 'JW', 'HU', 'VI', 'AN', 'OB', 'ER', 'FS', 'LY', 'PC', 'ZM' ]
 
canMakeWord = (word="") ->
Line 1,232 ⟶ 3,135:
# Expect true, true, false, true, false, true, true, true
for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"]
console.log word + " -> " + canMakeWord(word)</langsyntaxhighlight>
 
{{out}}
Line 1,243 ⟶ 3,146:
CONFUSE -> true
STORM -> true</pre>
 
=={{header|Comal}}==
<syntaxhighlight lang="comal">0010 FUNC can'make'word#(word$) CLOSED
0020 blocks$:=" BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
0030 FOR i#:=1 TO LEN(word$) DO
0040 pos#:=UPPER$(word$(i#)) IN blocks$
0050 IF NOT pos# THEN RETURN FALSE
0060 blocks$(pos#):="";blocks$(pos# BITXOR 1):=""
0070 ENDFOR i#
0080 RETURN TRUE
0090 ENDFUNC
0100 //
0110 DIM yesno$(0:1) OF 3
0120 yesno$(FALSE):="no";yesno$(TRUE):="yes"
0130 WHILE NOT EOD DO
0140 READ w$
0150 PRINT w$,": ",yesno$(can'make'word#(w$))
0160 ENDWHILE
0170 END
0180 //
0190 DATA "A","BARK","BOOK","treat","common","squad","CoNfUsE"</syntaxhighlight>
{{out}}
<pre>A: yes
BARK: yes
BOOK: no
treat: yes
common: no
squad: yes
CoNfUsE: yes</pre>
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">
(defun word-possible-p (word blocks)
(cond
Line 1,259 ⟶ 3,191:
collect (word-possible-p
(subseq word 1)
(remove b blocks))))))))</langsyntaxhighlight>
 
{{out}}
Line 1,278 ⟶ 3,210:
> (word-possible-p "abba" '("AB" "AB" "AC" "AC"))
T</pre>
 
=={{header|Component Pascal}}==
{{Works with|BlackBox Component Builder}}
<syntaxhighlight lang="oberon2">
MODULE ABCProblem;
IMPORT
StdLog, DevCommanders, TextMappers;
CONST
notfound = -1;
TYPE
String = ARRAY 3 OF CHAR;
VAR
blocks : ARRAY 20 OF String;
PROCEDURE Check(s: ARRAY OF CHAR): BOOLEAN;
VAR
used: SET;
i,blockIndex: INTEGER;
PROCEDURE GetBlockFor(c: CHAR): INTEGER;
VAR
i: INTEGER;
BEGIN
c := CAP(c);
i := 0;
WHILE (i < LEN(blocks)) DO
IF (c = blocks[i][0]) OR (c = blocks[i][1]) THEN
IF ~(i IN used) THEN RETURN i END
END;
INC(i)
END;
RETURN notfound
END GetBlockFor;
BEGIN
used := {};
FOR i := 0 TO LEN(s$) - 1 DO
blockIndex := GetBlockFor(s[i]);
IF blockIndex = notfound THEN
RETURN FALSE
ELSE
INCL(used,blockIndex)
END
END;
RETURN TRUE
END Check;
 
PROCEDURE CanMakeWord*;
VAR
s: TextMappers.Scanner;
BEGIN
s.ConnectTo(DevCommanders.par.text);
s.SetPos(DevCommanders.par.beg);
s.Scan;
WHILE (~s.rider.eot) DO
IF (s.type = TextMappers.char) & (s.char = '~') THEN
RETURN
ELSIF (s.type = TextMappers.string) THEN
StdLog.String(s.string);StdLog.String(":> ");
StdLog.Bool(Check(s.string));StdLog.Ln
END;
s.Scan
END
END CanMakeWord;
 
BEGIN
blocks[0] := "BO";
blocks[1] := "XK";
blocks[2] := "DQ";
blocks[3] := "CP";
blocks[4] := "NA";
blocks[5] := "GT";
blocks[6] := "RE";
blocks[7] := "TG";
blocks[8] := "QD";
blocks[9] := "FS";
blocks[10] := "JW";
blocks[11] := "HU";
blocks[12] := "VI";
blocks[13] := "AN";
blocks[14] := "OB";
blocks[15] := "ER";
blocks[16] := "FS";
blocks[17] := "LY";
blocks[18] := "PC";
blocks[19] := "ZM";
END ABCProblem.
</syntaxhighlight>
Execute: ^Q ABCProblem.CanMakeWord A BARK BOOK TREAT COMMON SQUAD confuse~
{{out}}
<pre>
A:> $TRUE
BARK:> $TRUE
BOOK:> $FALSE
TREAT:> $TRUE
COMMON:> $FALSE
SQUAD:> $TRUE
confuse:> $TRUE
</pre>
 
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
include "strings.coh";
 
sub can_make_word(word: [uint8]): (r: uint8) is
var blocks: [uint8] := "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM";
# Initialize blocks array
var avl: uint8[41];
CopyString(blocks, &avl[0]);
r := 1;
loop
var letter := [word];
word := @next word;
if letter == 0 then break; end if;
# find current letter in blocks
var i: @indexof avl := 0;
loop
var block := avl[i];
if block == 0 then
# no block, this word cannot be formed
r := 0;
return;
elseif block == letter then
# we found it, blank it out
avl[i] := ' ';
avl[i^1] := ' '; # and the other letter on the block too
break;
end if;
i := i + 1;
end loop;
end loop;
end sub;
 
# test a list of words
var words: [uint8][] := {"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"};
var resp: [uint8][] := {": No\n", ": Yes\n"};
var i: @indexof words := 0;
while i < @sizeof words loop
print(words[i]);
print(resp[can_make_word(words[i])]);
i := i + 1;
end loop;</syntaxhighlight>
 
{{out}}
 
<pre>A: Yes
BARK: Yes
BOOK: No
TREAT: Yes
COMMON: No
SQUAD: Yes
CONFUSE: Yes</pre>
 
=={{header|D}}==
Line 1,283 ⟶ 3,371:
{{trans|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.
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.string;
 
bool canMakeWord(in string word, in string[] blocks) pure /*nothrow*/ @safe {
Line 1,304 ⟶ 3,392:
foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
writefln(`"%s" %s`, word, canMakeWord(word, blocks));
}</langsyntaxhighlight>
{{out}}
<pre>"" true
Line 1,317 ⟶ 3,405:
===@nogc Version===
The same as the precedent version, but it avoids all heap allocations and it's lower-level and ASCII-only.
<langsyntaxhighlight lang="d">import std.ascii, core.stdc.stdlib;
 
bool canMakeWord(in string word, in string[] blocks) nothrow @nogc
Line 1,355 ⟶ 3,443:
foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
writefln(`"%s" %s`, word, canMakeWord(word, blocks));
}</langsyntaxhighlight>
 
===Recursive Version===
This version is able to find the solution for the word "abba" given the blocks AB AB AC AC.
{{trans|C}}
<langsyntaxhighlight lang="d">import std.stdio, std.ascii, std.algorithm, std.array;
 
alias Block = char[2];
Line 1,397 ⟶ 3,485:
immutable word = "abba";
writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
}</langsyntaxhighlight>
{{out}}
<pre>"" true
Line 1,411 ⟶ 3,499:
===Alternative Recursive Version===
This version doesn't shuffle the input blocks, but it's more complex and it allocates an array of indexes.
<langsyntaxhighlight lang="d">import std.stdio, std.ascii, std.algorithm, std.array, std.range;
 
alias Block = char[2];
Line 1,452 ⟶ 3,540:
immutable word = "abba";
writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
}</langsyntaxhighlight>
The output is the same.
 
=={{header|Delphi}}==
Just to be different I implemented a block as a set of (2) char rather than as an array of (2) char.
<langsyntaxhighlight Delphilang="delphi">program ABC;
{$APPTYPE CONSOLE}
 
Line 1,520 ⟶ 3,608:
readln;
end.
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,531 ⟶ 3,619:
Can make SQUAD
Can make CONFUSE
</pre>
 
=={{header|Draco}}==
<syntaxhighlight lang="draco">\util.g
 
proc nonrec ucase(char c) char:
byte b;
b := pretend(c, byte);
b := b & ~32;
pretend(b, char)
corp
 
proc nonrec can_make_word(*char w) bool:
[41] char blocks;
word i;
char ch;
bool found, ok;
CharsCopy(&blocks[0], "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM");
ok := true;
while
ch := ucase(w*);
w := w + 1;
ok and ch ~= '\e'
do
found := false;
i := 0;
while not found and i < 40 do
if blocks[i] = ch then found := true fi;
i := i + 1;
od;
if found then
i := i - 1;
blocks[i] := '\e';
blocks[i >< 1] := '\e'
else
ok := false
fi
od;
ok
corp
 
proc nonrec test(*char w) void:
writeln(w, ": ", if can_make_word(w) then "yes" else "no" fi)
corp
 
proc nonrec main() void:
test("A");
test("BARK");
test("book");
test("treat");
test("CoMmOn");
test("sQuAd");
test("CONFUSE")
corp</syntaxhighlight>
{{out}}
<pre>A: yes
BARK: yes
book: no
treat: yes
CoMmOn: no
sQuAd: yes
CONFUSE: yes</pre>
 
=={{header|Dyalect}}==
 
{{trans|Swift}}
 
<syntaxhighlight lang="dyalect">func blockable(str) {
var blocks = [
"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM" ]
var strUp = str.Upper()
var fin = ""
for c in strUp {
for j in blocks.Indices() {
if blocks[j].StartsWith(c) || blocks[j].EndsWith(c) {
fin += c
blocks[j] = ""
break
}
}
}
return fin == strUp
}
func canOrNot(can) => can ? "can" : "cannot"
for str in [ "A", "BARK", "BooK", "TrEaT", "comMON", "sQuAd", "Confuse" ] {
print("\"\(str)\" \(canOrNot(blockable(str))) be spelled with blocks.")
}</syntaxhighlight>
 
{{out}}
 
<pre>"A" can be spelled with blocks.
"BARK" can be spelled with blocks.
"BooK" cannot be spelled with blocks.
"TrEaT" can be spelled with blocks.
"comMON" cannot be spelled with blocks.
"sQuAd" can be spelled with blocks.
"Confuse" can be spelled with blocks.</pre>
 
=={{header|EasyLang}}==
<syntaxhighlight lang="easylang">
b$[][] = [ [ "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" ] ]
len b[] len b$[][]
global w$[] cnt .
#
proc backtr wi . .
if wi > len w$[]
cnt += 1
return
.
for i = 1 to len b$[][]
if b[i] = 0 and (b$[i][1] = w$[wi] or b$[i][2] = w$[wi])
b[i] = 1
backtr wi + 1
b[i] = 0
.
.
.
for s$ in [ "A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE" ]
w$[] = strchars s$
cnt = 0
backtr 1
print s$ & " can be spelled in " & cnt & " ways"
.
</syntaxhighlight>
 
{{out}}
<pre>
A can be spelled in 2 ways
BARK can be spelled in 8 ways
BOOK can be spelled in 0 ways
TREAT can be spelled in 8 ways
COMMON can be spelled in 0 ways
SQUAD can be spelled in 8 ways
CONFUSE can be spelled in 32 ways
</pre>
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
(lib 'list) ;; list-delete
 
Line 1,551 ⟶ 3,781:
(spell (string-rest word) (list-delete blocks block))))))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,570 ⟶ 3,800:
=={{header|Ela}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="ela">open list monad io char
 
:::IO
Line 1,586 ⟶ 3,816:
 
mapM_ (\w -> putLn (w, not << null $ abc blocks (map char.upper w)))
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]</langsyntaxhighlight>
 
{{out}}
Line 1,597 ⟶ 3,827:
("A",true)
("",true)</pre>
 
=={{header|Elena}}==
ELENA 6.0
<lang elena>#import system.
#<syntaxhighlight lang="elena">import system'routines.;
#import system'collections.;
#import extensions.system'culture;
#import extensions'routines.;
import extensions'routines;
 
#class(extension)op
extension op
{
#method canMakeWord &from:canMakeWordFrom(blocks)
[{
#var list := ArrayList new:.load(blocks.);
^ $nil == (cast string(self literal upperCase seek &each)).toUpper().seekEach::(ch)
[{
#var index := list indexOf:(word [ word indexOf:ch &at:0 != -1 ] asComparer).indexOfElement
((word => word.indexOf(0, ch) != -1).asComparator());
(index>=0)
if ? [ list remove &at:(index. ^ false. ]>=0)
! [ ^ true. ].{
list.removeAt(index); ^ false
].
] }
else
{
^ true
}
}
}
}
 
#symbolpublic program =()
{
[
#var blocks := (new string[]{"BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB",
"ER", "FS", "LY", "PC", "ZM").};
#var words := (new string[]{"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"). };
Enumerator e := words.enumerator();
words run &each:word
[e.next();
console writeLine:"can make '":word:"' : ":(word canMakeWord &from:blocks).
words.forEach::(word)
].
{
].</lang>
console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
}
}</syntaxhighlight>
{{out}}
<pre>
Line 1,649 ⟶ 3,890:
=={{header|Elixir}}==
{{trans|Erlang}}
{{works with|Elixir|1.3}}
<lang elixir>defmodule ABC do
<syntaxhighlight lang="elixir">defmodule ABC do
def can_make_word(word, avail) do
can_make_word(String.upcase(word) |> to_char_listto_charlist, avail, [])
end
Line 1,657 ⟶ 3,899:
defp can_make_word(_, [], _), do: false
defp can_make_word([l|tail], [b|rest], tried) do
(Enum.member?(b,l) in b and can_make_word(tail, rest++tried, []))
or can_make_word([l|tail], rest, [b|tried])
end
Line 1,664 ⟶ 3,906:
blocks = ~w(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM)c
~w(A Bark Book Treat Common Squad Confuse) |>
Enum.map(fn(w) -> IO.puts "#{w}: #{ABC.can_make_word(w, blocks)}" end)</langsyntaxhighlight>
 
{{out}}
Line 1,675 ⟶ 3,917:
Squad: true
Confuse: true
</pre>
 
=={{header|Elm}}==
{{works with|Elm|0.19.1}}
<syntaxhighlight lang="elm">
import Html exposing (div, p, text)
 
 
type alias Block = (Char, Char)
 
 
writtenWithBlock : Char -> Block -> Bool
writtenWithBlock letter (firstLetter, secondLetter) =
letter == firstLetter || letter == secondLetter
 
 
canMakeWord : List Block -> String -> Bool
canMakeWord blocks word =
let
checkWord w examinedBlocks blocksToExamine =
case (String.uncons w, blocksToExamine) of
(Nothing, _) -> True
(Just _, []) -> False
(Just (firstLetter, restOfWord), firstBlock::restOfBlocks) ->
if writtenWithBlock firstLetter firstBlock
then checkWord restOfWord [] (examinedBlocks ++ restOfBlocks)
else checkWord w (firstBlock::examinedBlocks) restOfBlocks
in
checkWord (String.toUpper word) [] blocks
exampleBlocks =
[ ('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')
]
 
exampleWords =
["", "A", "bark", "BoOK", "TrEAT", "COmMoN", "Squad", "conFUsE"]
 
 
main =
let resultStr (word, canBeWritten) = "\"" ++ word ++ "\"" ++ ": " ++ if canBeWritten then "True" else "False" in
List.map (\ word -> (word, canMakeWord exampleBlocks word) |> resultStr) exampleWords
|> List.map (\result -> p [] [ text result ])
|> div []
</syntaxhighlight>
 
{{out}}
<pre>
"": True
 
"A": True
 
"bark": True
 
"BoOK": False
 
"TrEAT": True
 
"COmMoN": False
 
"Squad": True
 
"conFUsE": True
</pre>
 
=={{header|Erlang}}==
<langsyntaxhighlight lang="erlang">-module(abc).
-export([can_make_word/1, can_make_word/2, blocks/0]).
 
Line 1,694 ⟶ 4,019:
main(_) -> lists:map(fun(W) -> io:fwrite("~s: ~s~n", [W, can_make_word(W)]) end,
["A","Bark","Book","Treat","Common","Squad","Confuse"]).
</syntaxhighlight>
</lang>
 
{{Out}}
Line 1,707 ⟶ 4,032:
 
=={{header|ERRE}}==
<syntaxhighlight lang="erre">
<lang ERRE>
PROGRAM BLOCKS
 
Line 1,736 ⟶ 4,061:
CANMAKEWORD("Confuse")
END PROGRAM
</syntaxhighlight>
</lang>
 
=={{header|Euphoria}}==
implemented using OpenEuphoria
<syntaxhighlight lang="euphoria">
<lang Euphoria>
include std/text.e
 
Line 1,776 ⟶ 4,101:
 
if getc(0) then end if
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,792 ⟶ 4,117:
=={{header|F_Sharp|F#}}==
<p>This solution does not depend on the order of the blocks, neither on the symmetry of blocks we see in the example block set. (Symmetry: if AB is a block, an A comes only with another AB|BA)</p>
<langsyntaxhighlight lang="fsharp">let rec spell_word_with blocks w =
let rec look_for_right_candidate candidates noCandidates c rest =
match candidates with
Line 1,821 ⟶ 4,146:
 
List.iter (fun w -> printfn "Using the blocks we can make the word '%s': %b" w (spell_word_with blocks w)) words
0</langsyntaxhighlight>
{{out}}
<pre>h:\RosettaCode\ABC\Fsharp>RosettaCode "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM" a bark book threat common squad confuse
Line 1,837 ⟶ 4,162:
h:\RosettaCode\ABC\Fsharp>RosettaCode "US TZ AO QA" Auto
Using the blocks we can make the word 'AUTO': true</pre>
 
{{trans|OCaml}}
<syntaxhighlight lang="fsharp">
let 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');
]
 
let find_letter blocks c =
let found, remaining =
List.partition (fun (c1, c2) -> c1 = c || c2 = c) blocks
in
match found with
| _ :: res -> Some (res @ remaining)
| _ -> None
 
let can_make_word w =
let n = String.length w in
let rec aux i _blocks =
if i >= n then true else
match find_letter _blocks w.[i] with
| None -> false
| Some rem_blocks ->
aux (i+1) rem_blocks
in
aux 0 blocks
 
let test label f (word, should) =
printfn "- %s %s = %A (should: %A)" label word (f word) should
 
let () =
List.iter (test "can make word" can_make_word) [
"A", true;
"BARK", true;
"BOOK", false;
"TREAT", true;
"COMMON", false;
"SQUAD", true;
"CONFUSE", true;
]
</syntaxhighlight>
 
=={{header|Factor}}==
<syntaxhighlight lang="factor">USING: assocs combinators.short-circuit formatting grouping io
kernel math math.statistics qw sequences sets unicode ;
IN: rosetta-code.abc-problem
 
! === CONSTANTS ================================================
 
CONSTANT: blocks qw{
BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
}
 
CONSTANT: input qw{ A BARK BOOK TREAT COMMON SQUAD CONFUSE }
 
! === PROGRAM LOGIC ============================================
 
: pare ( str -- seq )
[ blocks ] dip [ intersects? ] curry filter ;
 
: enough-blocks? ( str -- ? ) dup pare [ length ] bi@ <= ;
 
: enough-letters? ( str -- ? )
[ blocks concat ] dip dup [ within ] dip
[ histogram values ] bi@ [ - ] 2map [ neg? ] any? not ;
 
: can-make-word? ( str -- ? )
>upper { [ enough-blocks? ] [ enough-letters? ] } 1&& ;
 
! === OUTPUT ===================================================
 
: show-blocks ( -- )
"Available blocks:" print blocks [ 1 cut "(%s %s)" sprintf ]
map 5 group [ [ write bl ] each nl ] each nl ;
 
: header ( -- )
"Word" "Can make word from blocks?" "%-7s %s\n" printf
"======= ==========================" print ;
 
: result ( str -- )
dup can-make-word? "Yes" "No" ? "%-7s %s\n" printf ;
 
! === MAIN =====================================================
 
: abc-problem ( -- )
show-blocks header input [ result ] each ;
 
MAIN: abc-problem</syntaxhighlight>
{{out}}
<pre>
Available 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)
 
Word Can make word from blocks?
======= ==========================
A Yes
BARK Yes
BOOK No
TREAT Yes
COMMON No
SQUAD Yes
CONFUSE Yes
</pre>
 
=={{header|FBSL}}==
This approach uses a string, blanking out the pair previously found. Probably faster than array manipulation.
<langsyntaxhighlight lang="qbasic">
#APPTYPE CONSOLE
SUB MAIN()
Line 1,885 ⟶ 4,319:
RETURN TRUE
END FUNCTION
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,898 ⟶ 4,332:
Press any key to continue...
</pre>
 
 
 
=={{header|Forth}}==
 
{{works with|gforth|0.7.3}}
 
<syntaxhighlight lang="forth">: blockslist s" BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM" ;
variable blocks
: allotblocks ( -- ) here blockslist dup allot here over - swap move blocks ! ;
: freeblocks blockslist nip negate allot ;
: toupper 223 and ;
 
: clearblock ( addr-block -- )
dup '_' swap c!
dup blocks @ - 1 and if 1- else 1+ then
'_' swap c!
;
 
: pickblock ( addr-input -- addr-input+1 f )
dup 1+ swap c@ toupper ( -- addr-input+1 c )
blockslist nip 0 do
blocks @ i + dup c@ 2 pick ( -- addr-input+1 c addri ci c )
= if clearblock drop true unloop exit else drop then
loop drop false
;
 
: abc ( addr-input u -- f )
allotblocks
0 do
pickblock
invert if drop false unloop exit cr then
loop drop true
freeblocks
;
 
: .abc abc if ." True" else ." False" then ;</syntaxhighlight>
 
{{out}}
<pre>s" A" .abc True ok
s" BarK" .abc True ok
s" BOOK" .abc False ok
s" TrEaT" .abc True ok
s" COMMON" .abc False ok
s" SQUAD" .abc True ok
s" CONFUSE" .abc True ok
</pre>
 
 
=={{header|Fortran}}==
Attempts to write the word read from unit 5. Please find the output, bash command, and gfortran compilation instructions as commentary at the start of the source, which starts right away!
<langsyntaxhighlight Fortranlang="fortran">!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Thu Jun 5 01:52:03
!
Line 1,970 ⟶ 4,452:
end subroutine ucase
 
end program abc</langsyntaxhighlight>
 
===But if backtracking might be needed===
Line 1,978 ⟶ 4,460:
 
The following source begins with some support routines. Subroutine PLAY inspects the collection of blocks to make various remarks, and function CANBLOCK reports on whether a word can be spelled out with the supplied blocks. The source requires only a few of the F90 features. The MODULE protocol eases communication, but the key feature is that subprograms can now declare arrays of a size determined on entry via parameters. Previously, a constant with the largest-possible size would be required.
<syntaxhighlight lang="fortran">
<lang Fortran>
MODULE PLAYPEN !Messes with a set of alphabet blocks.
INTEGER MSG !Output unit number.
Line 2,256 ⟶ 4,738:
END DO
END
</syntaxhighlight>
</lang>
Output: the first column of T/F is the report from CANBLOCK, the second is the expected answer from the example, and the third is whether the two are in agreement.
<pre>
Line 2,278 ⟶ 4,760:
T T T SQUAD
T T T CONFUSE
</pre>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">' version 28-01-2019
' compile with: fbc -s console
 
Dim As String blocks(1 To 20, 1 To 2) => {{"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"}}
 
Dim As UInteger i, x, y, b()
Dim As String word, char
Dim As boolean possible
 
Do
Read word
If word = "" Then Exit Do
word = UCase(word)
ReDim b(1 To 20)
possible = TRUE
 
For i = 1 To Len(word)
char = Mid(word, i, 1)
 
For x = 1 To 20
If b(x) = 0 Then
If blocks(x, 1) = char Or blocks(x, 2) = char Then
b(x) = 1
Exit For
End If
End If
Next
If x = 21 Then possible = FALSE
Next
 
Print word, possible
Loop
 
Data "A", "Bark", "Book", "Treat", "Common", "Squad", "Confuse", ""
 
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>A true
BARK true
BOOK false
TREAT true
COMMON false
SQUAD true
CONFUSE true</pre>
 
 
=={{header|FutureBasic}}==
Here are two FutureBasic solutions for the "ABC Problem" task. The first is a straightforward function based on CFStrings, giving the standard YES or NO response.
 
The second is based on Pascal Strings, and offers a unique graphic presentation of the results, all in 18 lines of code. It accepts a word list delimited by spaces, commas, and/or semicolons.
 
'''FIRST SOLUTION:'''
 
Requires FB 7.0.23 or later
<syntaxhighlight lang="futurebasic">
include "NSLog.incl"
 
local fn CanBlocksSpell( w as CFStringRef ) as CFStringRef
NSUInteger i, j
CFStringRef s = @"", t1, t2 : if fn StringIsEqual( w, @"" ) then exit fn = @"YES" else w = ucase(w)
 
mda(0) = {@"BO",@"XK",@"DQ",@"CP",@"NA",@"GT",@"RE",@"TG",@"QD",¬
@"FS",@"JW",@"HU",@"VI",@"AN",@"OB",@"ER",@"FS",@"LY",@"PC",@"ZM"}
 
for i = 0 to len(w) - 1
for j = 0 to mda_count - 1
t1 = mid( mda(j), 0, 1 ) : t2 = mid( mda(j), 1, 1 )
if ( fn StringIsEqual( mid( w, i, 1 ), t1 ) ) then s = fn StringByAppendingString( s, t1 ) : mda(j) = @" " : break
if ( fn StringIsEqual( mid( w, i, 1 ), t2 ) ) then s = fn StringByAppendingString( s, t2 ) : mda(j) = @" " : break
next
next
if fn StringIsEqual( s, w ) then exit fn = @"YES"
end fn = @"NO"
 
NSUInteger i
CFArrayRef words
CFStringRef w
words = @[@"", @"a",@"Bark",@"BOOK",@"TrEaT",@"COMMON",@"Squad",@"conFUse",@"ABBA",@"aUtO"]
for w in words
printf @"Can blocks spell %7s : %@", fn StringUTF8String( w ), fn CanBlocksSpell( w )
next
 
NSLog( @"%@", fn WindowPrintViewString( 1 ) )
 
HandleEvents
</syntaxhighlight>
{{output}}
<pre>
Can blocks spell : YES
Can blocks spell a : YES
Can blocks spell Bark : YES
Can blocks spell BOOK : NO
Can blocks spell TrEaT : YES
Can blocks spell COMMON : NO
Can blocks spell Squad : YES
Can blocks spell conFUse : YES
Can blocks spell ABBA : YES
Can blocks spell aUtO : YES
</pre>
 
'''SECOND SOLUTION:'''
<syntaxhighlight lang="futurebasic">
 
local fn blocks( wordList as str255 )
sint16 found, r, x = 3, y = -9 : str63 ch, blocks : ch = " " : blocks = " "
for r = 1 to len$( wordList ) +1
found = instr$( 1, blocks, ch )
select found
case > 3: mid$( blocks, found and -2, 2 ) = "__" : text , , fn ColorYellow
rect fill ( x, y + 5.5, 15, 15 ), fn ColorBrown
case 0: text , , fn ColorLightGray
case < 4: blocks=" ,;BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM": x=3: y+=26: ch=""
end select
text @"Courier New Bold", 16 : print %( x + 2.5, y ) ch : x += 17
ch = ucase$( mid$( wordList, r, 1 ) )
next
end fn
 
window 1, @"ABC problem in FutureBasic", ( 0, 0, 300, 300 )
fn blocks( "a baRk booK;treat,COMMON squad Confused comparable incomparable nondeductibles" )
handleevents
 
</syntaxhighlight>
{{output}}
[[File:FB output for ABC--W on Br.png]]
 
=={{header|Gambas}}==
'''[https://gambas-playground.proko.eu/?gist=ae860292d4588b3627d77c85bcc634ee Click this link to run this code]'''
<syntaxhighlight lang="gambas">Public Sub Main()
Dim sCheck As String[] = ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"]
Dim sBlock As String[] = ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"]
Dim sList As New String[]
Dim siCount, siLoop As Short
Dim sTemp, sAnswer As String
 
For Each sTemp In sCheck
sAnswer = ""
sList = sBlock.Copy()
For siCount = 1 To Len(sTemp)
For siLoop = 0 To sList.Max
If InStr(sList[siLoop], Mid(sTemp, siCount, 1)) Then
sList.Extract(siLoop, 1)
sAnswer &= Mid(sTemp, siCount, 1)
Break
Endif
Next
Next
 
If sAnswer = sTemp Then
Print sTemp & " - True"
Else
Print sTemp & " - False"
End If
Next
 
End</syntaxhighlight>
Output:
<pre>
A - True
BARK - True
BOOK - False
TREAT - True
COMMON - False
SQUAD - True
CONFUSE - True
</pre>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 2,319 ⟶ 4,976:
fmt.Println(word, sp(word))
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,333 ⟶ 4,990:
=={{header|Groovy}}==
Solution:
<langsyntaxhighlight lang="groovy">class ABCSolver {
def blocks
 
Line 2,344 ⟶ 5,001:
word.every { letter -> blocksLeft.remove(blocksLeft.find { block -> block.contains(letter) }) }
}
}</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="groovy">def a = new ABCSolver(["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"])
 
['', 'A', 'BARK', 'book', 'treat', 'COMMON', 'SQuAd', 'CONFUSE'].each {
println "'${it}': ${a.canMakeWord(it)}"
}</langsyntaxhighlight>
 
{{out}}
Line 2,366 ⟶ 5,023:
=={{header|Harbour}}==
Harbour Project implements a cross-platform Clipper/xBase compiler.
<langsyntaxhighlight lang="visualfoxpro">PROCEDURE Main()
 
LOCAL cStr
Line 2,397 ⟶ 5,054:
NEXT
 
RETURN cFinal == cStr</langsyntaxhighlight>
{{out}}
<pre>
Line 2,411 ⟶ 5,068:
 
The following function returns a list of all the solutions. Since Haskell is lazy, testing whether the list is null will only do the minimal amount of work necessary to determine whether a solution exists.
<langsyntaxhighlight lang="haskell">import Data.List (delete)
import Data.Char (toUpper)
 
Line 2,425 ⟶ 5,082:
main :: IO ()
main = mapM_ (\w -> print (w, not . null $ abc blocks (map toUpper w)))
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]</langsyntaxhighlight>
 
{{out}}
Line 2,438 ⟶ 5,095:
("conFUsE",True)
</pre>
 
Or, in terms of the bind operator:
 
<syntaxhighlight lang="haskell">import Data.Char (toUpper)
import Data.List (delete)
 
 
----------------------- ABC PROBLEM ----------------------
 
spellWith :: [String] -> String -> [[String]]
spellWith _ [] = [[]]
spellWith blocks (x : xs) = blocks >>= go
where
go b
| x `elem` b = (b :) <$> spellWith (delete b blocks) xs
| otherwise = []
 
 
--------------------------- TEST -------------------------
main :: IO ()
main =
mapM_
( print
. ((,) <*>)
(not . null . spellWith blocks . fmap toUpper)
)
[ "",
"A",
"BARK",
"BoOK",
"TrEAT",
"COmMoN",
"SQUAD",
"conFUsE"
]
 
blocks :: [String]
blocks =
words $
"BO XK DQ CP NA GT RE TG QD FS JW"
<> " HU VI AN OB ER FS LY PC ZM"</syntaxhighlight>
{{Out}}
<pre>("",True)
("A",True)
("BARK",True)
("BoOK",False)
("TrEAT",True)
("COmMoN",False)
("SQUAD",True)
("conFUsE",True)</pre>
 
=={{header|Icon}} and {{header|Unicon}}==
Line 2,443 ⟶ 5,150:
 
Works in both languages:
<langsyntaxhighlight 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]
Line 2,466 ⟶ 5,173:
}
}
end</langsyntaxhighlight>
 
Sample run:
Line 2,480 ⟶ 5,187:
"CONFUSE" can be spelled with blocks.
->
</pre>
 
=={{header|Insitux}}==
<syntaxhighlight lang="insitux">
(function in-block? c
(when (let block-idx (find-idx (substr? (upper-case c)) rem-blocks))
(var! rem-blocks drop block-idx)))
 
(function can-make-word word
(var rem-blocks ["BO" "XK" "DQ" "CP" "NA" "GT" "RE" "TG" "QD" "FS" "JW" "HU" "VI" "AN" "OB" "ER" "FS" "LY" "PC" "ZM"])
(.. and (map in-block? word)))
 
(-> ["A" "bark" "Book" "TREAT" "Common" "squaD" "CoNFuSe"] ; Notice case insensitivity
(map #(str % " => " (can-make-word %)))
(join ", "))
</syntaxhighlight>
{{out}}
<pre>
A => true, bark => true, Book => false, TREAT => true, Common => false, squaD => true, CoNFuSe => true
</pre>
 
=={{header|J}}==
'''Solution:'''
<langsyntaxhighlight lang="j">reduce=: verb define
'rows cols'=. i.&.> $y
for_c. cols do.
Line 2,494 ⟶ 5,220:
)
 
abc=: *./@(+./)@reduce@(e."1~ ,)&toupper :: 0:</langsyntaxhighlight>
'''Examples:'''
<langsyntaxhighlight 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 '
 
Line 2,509 ⟶ 5,235:
"COmMOn" F
"SqUAD" T
"CoNfuSE" T</langsyntaxhighlight>
 
'''Tacit version'''
<langsyntaxhighlight lang="j">delElem=: {~<@<@<
uppc=:(-32*96&<*.123&>)&.(3&u:)
reduc=: ] delElem 1 i.~e."0 1
forms=: (1 - '' -: (reduc L:0/ :: (a:"_)@(<"0@],<@[))&uppc) L:0</langsyntaxhighlight>
 
{{out}}
Line 2,539 ⟶ 5,265:
Another approach might be:
 
<langsyntaxhighlight Jlang="j">Blocks=: >;:'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM '
ExampleWords=: ;: 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
 
Line 2,546 ⟶ 5,272:
need=: #/.~ word,word
relevant=: (x +./@e."1 word) # x
candidates=: word,"1>,{ {relevant
+./(((#need){. #/.~)"1 candidates) */ .>:need
)</langsyntaxhighlight>
 
Example use:
 
<langsyntaxhighlight Jlang="j"> Blocks canform 0{::ExampleWords
1
Blocks canform 1{::ExampleWords
Line 2,565 ⟶ 5,291:
1
Blocks canform 6{::ExampleWords
1</langsyntaxhighlight>
 
Explanation:
Line 2,575 ⟶ 5,301:
For example:
 
<langsyntaxhighlight Jlang="j"> Blocks canform 0{::ExampleWords
1
word
Line 2,588 ⟶ 5,314:
ANN
AAA
AAN</langsyntaxhighlight>
 
Here, the word is simply 'A', and we have two blocks to consider for our word: AN and NA. So we form all possible combinations of the letters of those two bocks, prefix each of them with our word and test whether any of them contain two copies of the letters of our word. (As it happens, allthree of the candidates are valid, for this trivial example.)
 
=={{header|Java}}==
{{trans|D}}
{{trans|C}}
{{works with|Java|1.6+}}
<langsyntaxhighlight lang="java5">import java.util.Arrays;
import java.util.Collections;
import java.util.List;
 
public class ABC {
private static void swap(int i, int j, Object... arr){
Object tmp = arr[i];
arr[i] = arr[j];
arr[j] = tmp;
}
public static boolean canMakeWord(String word, String... blocks) {
if(word.length() == 0)
return true;
char c = Character.toUpperCase(word.charAt(0));
for(int i = 0; i < blocks.length; i++) {
String b = blocks[i];
if(Character.toUpperCase(b.charAt(0)) != c && Character.toUpperCase(b.charAt(1)) != c)
continue;
swap(0, i, blocks);
if(canMakeWord(word.substring(1), Arrays.copyOfRange(blocks, 1, blocks.length)))
return true;
swap(0, i, blocks);
}
return false;
}
public static void main(String[] args){
String[] blocks = {"BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB",
"ER", "FS", "LY", "PC", "ZM"};
 
public static void main(String[] args) {
System.out.println("\"\": " + canMakeWord("", blocks));
List<String> blocks = Arrays.asList(
System.out.println("A: " + canMakeWord("A", blocks));
"BO", "XK", "DQ", "CP", "NA",
System.out.println("BARK: " + canMakeWord("BARK", blocks));
"GT", "RE", "TG", "QD", "FS",
System.out.println("book: " + canMakeWord("book", blocks));
"JW", "HU", "VI", "AN", "OB",
System.out.println("treat: " + canMakeWord("treat", blocks));
"ER", "FS", "LY", "PC", "ZM");
System.out.println("COMMON: " + canMakeWord("COMMON", blocks));
 
System.out.println("SQuAd: " + canMakeWord("SQuAd", blocks));
for (String word : Arrays.asList("", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE")) {
System.out.println("CONFUSE: " + canMakeWord("CONFUSE", blocks));
System.out.printf("%s: %s%n", word.isEmpty() ? "\"\"" : word, canMakeWord(word, blocks));
}
}
}
}</lang>
 
public static boolean canMakeWord(String word, List<String> blocks) {
if (word.isEmpty())
return true;
 
char c = word.charAt(0);
for (int i = 0; i < blocks.size(); i++) {
String b = blocks.get(i);
if (b.charAt(0) != c && b.charAt(1) != c)
continue;
Collections.swap(blocks, 0, i);
if (canMakeWord(word.substring(1), blocks.subList(1, blocks.size())))
return true;
Collections.swap(blocks, 0, i);
}
 
return false;
}
}</syntaxhighlight>
{{out}}
<pre>"": true
Line 2,651 ⟶ 5,368:
 
=={{header|JavaScript}}==
===RegexES5===
====Imperative====
The following method uses regular expressions and the string replace function to allow more support for older browsers.
<langsyntaxhighlight lang="javascript">var blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
 
function CheckWord(blocks, word) {
Line 2,690 ⟶ 5,408:
for(var i = 0;i<words.length;++i)
console.log(words[i] + ": " + CheckWord(blocks, words[i]));
</syntaxhighlight>
</lang>
 
Result:
Line 2,703 ⟶ 5,421:
</pre>
 
====Functional (ES 5)====
<syntaxhighlight lang="javascript">(function (strWords) {
 
<lang JavaScript>(function (strWords) {
 
var strBlocks =
Line 2,752 ⟶ 5,469:
return strWords.split(' ').map(solution).join('\n');
 
})('A bark BooK TReAT COMMON squAD conFUSE');</langsyntaxhighlight>
 
{{Out}}
<syntaxhighlight lang="javascript">A -> NA
 
<lang JavaScript>A -> NA
bark -> BO NA RE XK
BooK: [no solution]
Line 2,762 ⟶ 5,477:
COMMON: [no solution]
squAD -> FS DQ HU NA QD
conFUSE -> CP BO NA FS HU FS RE</langsyntaxhighlight>
 
===ES6===
====Imperative====
<lang javascript>let characters = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
<syntaxhighlight lang="javascript">let characters = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
let blocks = characters.split(" ").map(pair => pair.split(""));
Line 2,797 ⟶ 5,513:
"CONFUSE"
].forEach(word => console.log(`${word}: ${isWordPossible(word)}`));
</syntaxhighlight>
</lang>
 
Result:
Line 2,807 ⟶ 5,523:
SQUAD: true
CONFUSE: true</pre>
 
 
====Functional====
{{Trans|Haskell}}
<syntaxhighlight lang="javascript">(() => {
"use strict";
 
// ------------------- ABC BLOCKS --------------------
 
// spellWith :: [(Char, Char)] -> [Char] -> [[(Char, Char)]]
const spellWith = blocks =>
wordChars => !Boolean(wordChars.length) ? [
[]
] : (() => {
const [x, ...xs] = wordChars;
 
return blocks.flatMap(
b => b.includes(x) ? (
spellWith(
deleteBy(
p => q => (p[0] === q[0]) && (
p[1] === q[1]
)
)(b)(blocks)
)(xs)
.flatMap(bs => [b, ...bs])
) : []
);
})();
 
 
// ---------------------- TEST -----------------------
const main = () => {
const blocks = (
"BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
).split(" ");
 
return [
"", "A", "BARK", "BoOK", "TrEAT",
"COmMoN", "SQUAD", "conFUsE"
]
.map(
x => JSON.stringify([
x, !Boolean(
spellWith(blocks)(
[...x.toLocaleUpperCase()]
)
.length
)
])
)
.join("\n");
};
 
// ---------------- GENERIC FUNCTIONS ----------------
 
// deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
const deleteBy = fEq =>
x => {
const go = xs => Boolean(xs.length) ? (
fEq(x)(xs[0]) ? (
xs.slice(1)
) : [xs[0], ...go(xs.slice(1))]
) : [];
 
return go;
};
 
// MAIN ---
return main();
})();</syntaxhighlight>
{{Out}}
<pre>["",true]
["A",true]
["BARK",true]
["BoOK",false]
["TrEAT",true]
["COmMoN",false]
["SQUAD",true]
["conFUsE",true]</pre>
 
=={{header|jq}}==
The problem description seems to imply that if a letter, X, appears on more than one block, its partner will be the same on all blocks. This makes the problem trivial.<langsyntaxhighlight lang="jq">
# when_index(cond;ary) returns the index of the first element in ary
# that satisfies cond; it uses a helper function that takes advantage
Line 2,838 ⟶ 5,634:
else .[1:] | abc($blks)
end
end;</langsyntaxhighlight>
Task:<langsyntaxhighlight lang="jq">def task:
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] as $blocks
| ("A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE")
| "\(.) : \( .|abc($blocks) )" ;task</langsyntaxhighlight>
{{Out}}
A : true
Line 2,852 ⟶ 5,648:
SQUAD : true
CONFUSE : true
 
=={{header|Jsish}}==
Based on Javascript ES5 imperative solution.
<syntaxhighlight lang="javascript">#!/usr/bin/env jsish
/* ABC problem, in Jsish. Can word be spelled with the given letter blocks. */
var blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
function CheckWord(blocks, word) {
var re = /([a-z]*)/i;
if (word !== re.exec(word)[0]) return false;
for (var i = 0; i < word.length; i++) {
var letter = word.charAt(i);
var length = blocks.length;
// trying both sides
var reg = new RegExp("([a-z]"+letter + "|" + letter+"[a-z])", "i");
// remove block once a letter is used
blocks = blocks.replace(reg, "");
if (blocks.length === length) return false;
}
return true;
};
 
var words = [ "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE" ];
 
puts("Using blocks:", blocks);
for(var i = 0; i<words.length; i++)
puts(CheckWord(blocks, words[i]) ? "can" : "can't", "spell", words[i]);
 
/*
=!EXPECTSTART!=
Using blocks: BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
can spell A
can spell BARK
can't spell BOOK
can spell TREAT
can't spell COMMON
can spell SQUAD
can spell CONFUSE
=!EXPECTEND!=
*/</syntaxhighlight>
 
{{out}}
<pre>prompt$ jsish ABCProblem.jsi
Using blocks: BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
can spell A
can spell BARK
can't spell BOOK
can spell TREAT
can't spell COMMON
can spell SQUAD
can spell CONFUSE
 
prompt$ jsish -u ABCProblem.jsi
[PASS] ABCProblem.jsi</pre>
 
=={{header|Julia}}==
<syntaxhighlight lang="julia">using Printf
<lang Julia>function abc (str, list)
 
isempty(str) && return true
function abc(str::AbstractString, list)
for i = eachindex(list)
isempty(str[end] in list[i]) && return true
for i in eachindex(list)
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
str[end] in list[i] &&
return true
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
end
return true
false
end</lang>
return false
{{Out}}
end
<pre>julia> let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"],
 
list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
let test = ["JWA", "HUBARK","VIBOOK","ANTREAT","OBCOMMON","ERSQUAD","FSCONFUSE"],"LY","PC","ZM"]
list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
for str in test
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
@printf("%-8s | %s\n", str, abc(str, list))
for str in endtest
@printf("%-8s | %s\n", str, abc(str, list))
end
A | trueend
end</syntaxhighlight>
 
{{out}}
<pre>A | true
BARK | true
BOOK | false
Line 2,879 ⟶ 5,733:
CONFUSE | true</pre>
 
=={{header|Koka}}==
{{trans|Python}}with some Koka specific updates
<syntaxhighlight lang="koka">
val 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")]
 
pub fun get-remove( xs : list<a>, pred : a -> bool, acc: ctx<list<a>>) : (maybe<a>, list<a>)
match xs
Cons(x,xx) -> if !pred(x) then xx.get-remove(pred, acc ++ ctx Cons(x, _)) else (Just(x), acc ++. xx)
Nil -> (Nothing, acc ++. Nil)
 
fun check-word(word: string, blocks: list<(string, string)>)
match word.head
"" -> True
x ->
val (a, l) = blocks.get-remove(fn(a) a.fst == x || a.snd == x, ctx _)
match a
Nothing -> False
Just(_) -> check-word(word.tail, l)
 
fun can-make-word(word, blocks: list<(string, string)>)
check-word(word.to-upper, blocks)
 
fun main()
val words = ["", "a", "baRk", "booK", "treat", "COMMON", "squad", "Confused"]
words.map(fn(a) (a, can-make-word(a, blocks))).foreach fn((w, b))
println(w.show ++ " " ++ (if b then "can" else "cannot") ++ " be made")
</syntaxhighlight>
{{out}}
<pre>"": true
"" can be made
"a" can be made
"baRk" can be made
"booK" cannot be made
"treat" can be made
"COMMON" cannot be made
"squad" can be made
"Confused" can be made
</pre>
=={{header|Kotlin}}==
{{trans|Java}}
<syntaxhighlight lang="scala">object ABC_block_checker {
<lang scala>package abc
 
object ABC_block_checker {
fun run() {
val blocks = arrayOf("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM")
 
println("\"\": " + blocks.canMakeWord(""))
for (w in words) println("$w: " + blocks.canMakeWord(w))
val words = arrayOf("A", "BARK", "book", "treat", "COMMON", "SQuAd", "CONFUSE")
for (w in words) println("$w: " + blocks.canMakeWord(w))
}
 
Line 2,900 ⟶ 5,805:
 
private fun Array<String>.canMakeWord(word: String): Boolean {
if (word.length == 0isEmpty())
return true
 
val c = Character.toUpperCase(word.first().toUpperCase()
var i = 0
forEach { b ->
Line 2,917 ⟶ 5,822:
return false
}
 
private val blocks = arrayOf(
"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"
)
private val words = arrayOf("A", "BARK", "book", "treat", "COMMON", "SQuAd", "CONFUSE")
}
 
fun main(args: Array<String>) = ABC_block_checker.run()</langsyntaxhighlight>
{{out}}
<pre>"": true
Line 2,929 ⟶ 5,840:
SQuAd: true
CONFUSE: true</pre>
 
=={{header|Lang}}==
{{trans|Java}}
<syntaxhighlight lang="lang">
fp.canMakeWord = ($word, $blocks) -> {
if(!$word) {
return 1
}
$word = fn.toLower($word)
$c $= $word[0]
$i = 0
while($i < @$blocks) {
$block $= fn.toLower($blocks[$i])
if($block[0] != $c && $block[1] != $c) {
$i += 1
con.continue
}
$blocksCopy $= ^$blocks
fn.listRemoveAt($blocksCopy, $i)
if(fp.canMakeWord(fn.substring($word, 1), $blocksCopy)) {
return 1
}
$i += 1
}
return 0
}
 
$blocks = fn.listOf(BO, XK, DQ, CP, NA, GT, RE, TG, QD, FS, JW, HU, VI, AN, OB, ER, FS, LY, PC, ZM)
 
$word
foreach($[word], [\e, A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE, Treat, cOmMoN]) {
fn.printf(%s: %s%n, $word, fp.canMakeWord($word, $blocks))
}
</syntaxhighlight>
{{out}}
<pre>
: 1
A: 1
BARK: 1
BOOK: 0
TREAT: 1
COMMON: 0
SQUAD: 1
CONFUSE: 1
Treat: 1
cOmMoN: 0
</pre>
 
=={{header|Liberty BASIC}}==
===Recursive solution===
<syntaxhighlight lang="lb">
<lang lb>
print "Rosetta Code - ABC problem (recursive solution)"
print
Line 2,975 ⟶ 5,941:
wend
end function
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,997 ⟶ 5,963:
</pre>
===Procedural solution===
<syntaxhighlight lang="lb">
<lang lb>
print "Rosetta Code - ABC problem (procedural solution)"
print
Line 3,131 ⟶ 6,097:
LetterOK=1
end sub
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,154 ⟶ 6,120:
 
=={{header|Logo}}==
<langsyntaxhighlight lang="logo">make "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]]
 
Line 3,174 ⟶ 6,140:
]
 
bye</langsyntaxhighlight>
 
{{Out}}
Line 3,184 ⟶ 6,150:
SQUAD: true
CONFUSE: true</pre>
 
=={{header|Logtalk}}==
 
A possible Logtalk implementation of this problem could look like this:
 
<syntaxhighlight lang="logtalk">
:- object(blocks(_Block_Set_)).
 
:- public(can_spell/1).
:- public(spell_no_spell/3).
 
:- uses(character, [lower_upper/2, is_upper_case/1]).
% public interface
 
can_spell(Atom) :-
atom_chars(Atom, Chars),
to_lower(Chars, Lower),
can_spell(_Block_Set_, Lower).
 
spell_no_spell(Words, Spellable, Unspellable) :-
meta::partition(can_spell, Words, Spellable, Unspellable).
 
% local helper predicates
 
can_spell(_, []).
can_spell(Blocks0, [H|T]) :-
( list::selectchk(b(H,_), Blocks0, Blocks1)
; list::selectchk(b(_,H), Blocks0, Blocks1)
),
can_spell(Blocks1, T).
 
to_lower(Chars, Lower) :-
meta::map(
[C,L] >> (is_upper_case(C) -> lower_upper(L, C); C = L),
Chars,
Lower
).
 
:- end_object.
</syntaxhighlight>
 
The object is a parameterized object, allowing different block sets to be tested against word lists with trivial ease. It exposes two predicates in its public interface: <code>can_spell/1</code>, which succeeds if the provided argument is an atom which can be spelled with the block set, and <code>spell_no_spell</code>, which partitions a list of words into two lists: a list of words which can be spelled by the blocks, and a list of words which cannot be spelled by the blocks.
 
A test object driving <code>blocks</code> could look something like this:
 
<syntaxhighlight lang="logtalk">
:- object(blocks_test).
 
:- public(run/0).
 
:- uses(logtalk, [print_message(information, blocks, Message) as print(Message)]).
 
run :-
block_set(BlockSet),
word_list(WordList),
blocks(BlockSet)::spell_no_spell(WordList, S, U),
print('The following words can be spelled by this block set'::S),
print('The following words cannot be spelled by this block set'::U).
 
% test configuration data
 
block_set([b(b,o), b(x,k), b(d,q), b(c,p), b(n,a),
b(g,t), b(r,e), b(t,g), b(q,d), b(f,s),
b(j,w), b(h,u), b(v,i), b(a,n), b(o,b),
b(e,r), b(f,s), b(l,y), b(p,c), b(z,m)]).
 
word_list(['', 'A', 'bark', 'bOOk', 'treAT', 'COmmon', 'sQuaD', 'CONFUSE']).
 
:- end_object.
</syntaxhighlight>
 
Before running the test, some libraries will have to be loaded (typically found in a file called <code>loader.lgt</code>). Presuming the object and the test are both in a file called <code>blocks.lgt</code> the loader file could look something like this:
 
<syntaxhighlight lang="logtalk">
:- initialization((
% libraries
logtalk_load(meta(loader)),
logtalk_load(types(loader)),
% application
logtalk_load([blocks, blocks_test])
)).
</syntaxhighlight>
 
{{Out}}
 
Putting this all together, a session testing the object would look like this:
 
<pre>
?- {loader}.
% ... messages elided ...
true.
 
?- blocks_test::run.
% The following words can be spelled by this block set:
% - ''
% - 'A'
% - bark
% - treAT
% - sQuaD
% - 'CONFUSE'
% The following words cannot be spelled by this block set:
% - bOOk
% - 'COmmon'
true.
 
?-
</pre>
 
Of course in this simple example only the lists of words in each category gets printed. Better-formatted output is possible (and likely desirable) but out of scope for the problem.
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">blocks = {
{"B","O"}; {"X","K"}; {"D","Q"}; {"C","P"};
{"N","A"}; {"G","T"}; {"R","E"}; {"T","G"};
Line 3,216 ⟶ 6,292:
end
print(found)
end</langsyntaxhighlight>
 
{{Output}}
Line 3,227 ⟶ 6,303:
canMake("SQUAD"): true
canMake("CONFUSE"): true</pre>
 
=={{header|M2000 Interpreter}}==
We use a subroutine inside a module. Subs are in the same namespace as the module which call them. Subs may exist in the end of module, or in the parent module (which module defined). We have to use Local to define new variables which shadow any module variable. When a sub exit all new variables which made there erased. Modules run on objects which "interprets" code, and subs use modules objects, so they are lighter than modules. A module hold a separate return stack for subs, gosub and for next structures ( a for {} use process stack, and is twice faster as the simple For Next). This return stack is a stack object, which is a collection of objects in heap, so we can use '''Recursion.Limit 100000''' to set limit to 100000 calls for subs. Here we use a for next and a subroutine, using modules dedicated return stack. We can call can_make_word() using name or using Gosub. Gosub can call subs as labels, and expect Return to return from sub. These routines are more lighter than subs, because they run as code is in module, and any new variable stay until module exit. So we never make local variables or if we want locals we have to use Fopr This { }, the block for temporary definitions.
 
 
<syntaxhighlight lang="m2000 interpreter">
Module ABC {
can_make_word("A")
can_make_word("BaRk")
can_make_word("BOOK")
can_make_word("TREAT")
can_make_word("CommoN")
can_make_word("SQUAD")
Gosub can_make_word("CONFUSE") ' we can use Gosub before
Sub can_make_word(c$)
local b$=ucase$(c$)
local i, a$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM", m
for i=1 to len(b$)
m=Instr(a$,mid$(b$, i, 1))
If m=0 Then Exit for
Insert binary.or(m-1, 1),2 a$="" ' delete 2 chars
Next i
Print c$, m<>0
End Sub
}
ABC
</syntaxhighlight>
 
{{out}}
<pre >
A True
BaRk True
BOOK False
TREAT True
CommoN False
SQUAD True
CONFUSE True
</pre >
 
=={{header|MACRO-11}}==
<syntaxhighlight lang="macro11"> .TITLE ABC
.MCALL .TTYOUT,.EXIT
ABC:: JMP DEMO
 
; SEE IF R0 CAN BE MADE WITH THE BLOCKS
BLOCKS: MOV #7$,R1
MOV #6$,R2
1$: MOVB (R1)+,(R2)+ ; INITIALIZE BLOCKS
BNE 1$
BR 4$
2$: BIC #40,R1 ; MAKE UPPERCASE
MOV #6$,R2
3$: MOVB (R2)+,R3 ; GET BLOCK
BEQ 5$ ; OUT OF BLOCKS: NO MATCH
CMP R1,R3 ; MATCHING BLOCK?
BNE 3$ ; NO: CHECK NEXT BLOCK
DEC R2 ; FOUND BLOCK: CLEAR BLOCK
BIC #1,R2
MOV #-1,(R2)
4$: MOVB (R0)+,R1
BNE 2$
RTS PC ; END OF STRING: RETURN WITH Z SET
5$: CCC ; FAIL: RETURN WITH Z CLEAR
RTS PC
6$: .ASCIZ / /
7$: .ASCIZ /BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM/
 
DEMO: MOV #WORDS,R4
1$: MOV (R4)+,R5
BEQ 4$
MOV R5,R1
JSR PC,5$
MOV R5,R0
JSR PC,BLOCKS
BNE 2$
MOV #6$,R1
BR 3$
2$: MOV #7$,R1
3$: JSR PC,5$
BR 1$
4$: .EXIT
5$: MOVB (R1)+,R0
.TTYOUT
BNE 5$
RTS PC
6$: .ASCIZ /: YES/<15><12>
7$: .ASCIZ /: NO/<15><12>
.EVEN
 
WORDS: .WORD 1$,2$,3$,4$,5$,6$,7$,0
1$: .ASCIZ /A/
2$: .ASCIZ /BARK/
3$: .ASCIZ /book/
4$: .ASCIZ /TREAT/
5$: .ASCIZ /common/
6$: .ASCIZ /SqUaD/
7$: .ASCIZ /cOnFuSe/
.END ABC</syntaxhighlight>
{{out}}
<pre>A: YES
BARK: YES
book: NO
TREAT: YES
common: NO
SqUaD: YES
cOnFuSe: YES</pre>
 
=={{header|Maple}}==
<langsyntaxhighlight lang="maple">canSpell := proc(w)
local blocks, i, j, word, letterFound;
blocks := Array([["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"], ["Q", "D"], ["F", "S"],
["J", "W"], ["H", "U"], ["VQ", "ID"], ["AF", "NS"], ["OJ", "BW"], ["EH", "RU"], ["FV", "SI"], ["LA", "YN"], ["PO", "CB"], ["ZE", "MR"]];,
["F", "S"], ["L", "Y"], ["P", "C"], ["Z", "M"]]);
word := StringTools[UpperCase](convert(w, string));
for i to length(word) do
letterFound := false;
for j to numelems(blocks)/2 do
if not letterFound and (substring(word, i) = blocks[j][,1] or substring(word, i) = blocks[j][,2]) then
blocks[j][,1] := undefined;
blocks[j][,2] := undefined;
letterFound := true;
end if;
Line 3,250 ⟶ 6,433:
end proc:
 
seq(printf("%a: %a\n", i, canSpell(i)), i in [a, Bark, bOok, treat, COMMON, squad, confuse]);</langsyntaxhighlight>
{{out}}
<pre>
Line 3,263 ⟶ 6,446:
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
<lang Mathematica>
blocks=Partition[Characters[ToLowerCase["BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"]],2];
ClearAll[DoStep,ABCBlockQ]
Line 3,276 ⟶ 6,459:
DoStep[opts_List]:=Flatten[DoStep@@@opts,1]
ABCBlockQ[str_String]:=(FixedPoint[DoStep,{{Characters[ToLowerCase[str]],blocks,{}}}]=!={})
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 3,295 ⟶ 6,478:
</pre>
 
=={{header|MATLAB}} / {{header|Octave}}==
<langsyntaxhighlight MATLABlang="matlab">function testABC
combos = ['BO' ; 'XK' ; 'DQ' ; 'CP' ; 'NA' ; 'GT' ; 'RE' ; 'TG' ; 'QD' ; ...
'FS' ; 'JW' ; 'HU' ; 'VI' ; 'AN' ; 'OB' ; 'ER' ; 'FS' ; 'LY' ; ...
Line 3,321 ⟶ 6,504:
k = k+1;
end
end</langsyntaxhighlight>
{{out}}
<pre>Can make word A.
Line 3,337 ⟶ 6,520:
Recursively checks if the word is possible if a block is removed from the array.
 
<syntaxhighlight lang="maxscript">
<lang MAXScript>
-- This is the blocks array
global GlobalBlocks = #("BO","XK","DQ","CP","NA", \
Line 3,436 ⟶ 6,619:
)
)
</syntaxhighlight>
</lang>
 
'''Output:'''
<syntaxhighlight lang="maxscript">
<lang MAXScript>
iswordpossible "a"
true
Line 3,454 ⟶ 6,637:
iswordpossible "confuse"
true
</syntaxhighlight>
</lang>
 
 
=== Non-recursive ===
<syntaxhighlight lang="maxscript">
<lang MAXScript>
fn isWordPossible2 word =
(
Line 3,489 ⟶ 6,672:
) else return false
)
</syntaxhighlight>
</lang>
 
Both versions are good for this example, but the non-recursive version won't work if the blocks are more random, because it just takes the first found block, and the recursive version decides which one to use.
Line 3,495 ⟶ 6,678:
Then:
 
<syntaxhighlight lang="maxscript">
<lang MAXScript>
iswordpossible "water"
true
iswordpossible2 "water"
false
</syntaxhighlight>
</lang>
 
Non-recursive version quickly decides that it's not possible, even though it clearly is.
 
=={{header|NimMercury}}==
<syntaxhighlight lang="mercury">:- module abc.
<lang nim>from strutils import contains, format, toUpper
:- interface.
from sequtils import delete
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list, string, char.
 
:- type block == {char, char}.
proc canMakeWord(s: string): bool =
var
abcs = @["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"]
matched = newSeq[string]()
 
:- pred take(char, list(block), list(block)).
if s.len > abcs.len:
:- mode take(in, in, out) is nondet.
return false
take(C, !Blocks) :-
list.delete(!.Blocks, {A, B}, !:Blocks),
( A = C ; B = C ).
 
:- pred can_make_word(list(char)::in, list(block)::in) is semidet.
for i in 0 .. s.len - 1:
can_make_word([], _).
var
can_make_word([C|Cs], !.Blocks) :-
letter = s[i].toUpper
take(C, n = 0!Blocks),
can_make_word(Cs, !.Blocks).
for abc in abcs:
if contains(abc, letter):
delete(abcs, n, n)
matched = matched & abc
break
else:
inc(n)
 
main(!IO) :-
if matched.len == s.len:
returnBlocks true= [
{'B', 'O'}, {'X', 'K'}, {'D', 'Q'}, {'C', 'P'}, {'N', 'A'},
else:
{'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'}
],
Words = ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"],
foldl((pred(W::in, !.IO::di, !:IO::uo) is det :-
P = can_make_word(to_char_list(W), Blocks),
io.format("can_make_word(""%s"") :- %s.\n",
[s(W), s(if P then "true" else "fail")], !IO)),
Words, !IO).</syntaxhighlight>
 
Note that 'P', in the foldl near the end, is not a boolean variable, but a zero-arity currying of can_make_word (i.e., it's a 'lambda' that takes no arguments and then calls can_make_word with all of the already-supplied arguments).
 
=={{header|MiniScript}}==
<syntaxhighlight lang="miniscript">allBlocks = ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"]
swap = function(list, index1, index2)
tmp = list[index1]
list[index1] = list[index2]
list[index2] = tmp
end function
canMakeWord = function(str, blocks)
if str == "" then return true
c = str[0].upper
for i in range(0, blocks.len - 1)
bl = blocks[i]
if c != bl[0] and c != bl[1] then continue
swap blocks, 0, i
if canMakeWord(str[1:], blocks[1:]) then return true
swap blocks, 0, i
end for
return false
end function
for val in ["", "A", "BARK", "book", "Treat", "COMMON", "sQuAD", "CONFUSE"]
out = """"""
if val.len != 0 then out = val
print out + ": " + canMakeWord(val, allBlocks)
end for
</syntaxhighlight>
 
=={{header|Miranda}}==
var words = @["A", "bArK", "BOOK", "treat", "common", "sQuAd", "CONFUSE"]
<syntaxhighlight lang="miranda">main :: [sys_message]
for word in words:
main = [Stdout (lay [word ++ ": " ++ show (canmakeword blocks word) | word <- tests])]
echo format("Can the blocks make the word \"$1\"? $2", word,
 
(if canMakeWord(word): "yes" else: "no"))</lang>
tests :: [[char]]
tests = ["A","BARK","BOOK","TREAT","common","SqUaD","cOnFuSe"]
 
canmakeword :: [[char]]->[char]->bool
canmakeword [] word = False
canmakeword blocks [] = True
canmakeword blocks (a:as) = #match ~= 0 & canmakeword rest as
where match = [b | b<-blocks; ucase a $in b]
rest = hd match $del blocks
 
del :: *->[*]->[*]
del item [] = []
del item (a:as) = a:del item as, if a ~= item
= as, otherwise
 
in :: *->[*]->bool
in item [] = False
in item (a:as) = a = item \/ item $in as
 
ucase :: char->char
ucase ch = ch, if n<code 'a' \/ n>code 'z'
= decode (n-32), otherwise
where n = code ch
 
blocks :: [[char]]
blocks = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]</syntaxhighlight>
{{out}}
<pre>A: True
BARK: True
BOOK: False
TREAT: True
common: False
SqUaD: True
cOnFuSe: True</pre>
=={{header|Nim}}==
{{works with|Nim|0.20.0}}⊂
<syntaxhighlight lang="nim">import std / strutils
 
func canMakeWord(blocks: seq[string]; word: string): bool =
if blocks.len < word.len: return false
if word.len == 0: return true
 
let ch = word[0].toUpperAscii
for i, pair in blocks:
if ch in pair and
(blocks[0..<i] & blocks[i+1..^1]).canMakeWord(word[1..^1]):
return true
 
proc main =
for (blocks, words) in [
("BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM".splitWhitespace,
@["A", "bArK", "BOOK", "treat", "common", "sQuAd", "CONFUSE"]),
("AB AB AC AC".splitWhitespace, @["ABBa"]),
("US TZ AO QA".splitWhitespace, @["Auto"])
]:
echo "Using the blocks ", blocks.join(" ")
for word in words:
echo " can we make the word '$#'? $#" % [
word, if blocks.canMakeWord(word): "yes" else: "no"]
echo()
 
when isMainModule: main()</syntaxhighlight>
{{Out}}
<pre>CanUsing the blocks makeBO theXK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS wordLY "A"?PC yesZM
Can can the blockswe make the word "bArK"'A'? yes
Can can the blockswe make the word "BOOK"'bArK'? noyes
Can can the blockswe make the word "treat"'BOOK'? yesno
Can can the blockswe make the word "common"'treat'? noyes
Can can the blockswe make the word "sQuAd"'common'? yesno
Can can the blockswe make the word "CONFUSE"'sQuAd'? yes</pre>
can we make the word 'CONFUSE'? yes
 
Using the blocks AB AB AC AC
can we make the word 'ABBa'? yes
 
Using the blocks US TZ AO QA
can we make the word 'Auto'? yes</pre>
 
=={{header|Oberon-2}}==
Works with oo2c Version 2
<langsyntaxhighlight lang="oberon2">
MODULE ABCBlocks;
IMPORT
Line 3,633 ⟶ 6,923:
Out.String("confuse: ");Out.Bool(CanMakeWord("confuse"));Out.Ln;
END ABCBlocks.
</syntaxhighlight>
</lang>
Output:
<pre>
Line 3,647 ⟶ 6,937:
=={{header|Objeck}}==
{{trans|Java}}
<langsyntaxhighlight lang="objeck">class Abc {
function : Main(args : String[]) ~ Nil {
blocks := ["BO", "XK", "DQ", "CP", "NA",
Line 3,692 ⟶ 6,982:
arr[j] := tmp;
}
}</langsyntaxhighlight>
<pre>
"": true
Line 3,705 ⟶ 6,995:
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">let blocks = [
('B', 'O'); ('X', 'K'); ('D', 'Q'); ('C', 'P');
('N', 'A'); ('G', 'T'); ('R', 'E'); ('T', 'G');
Line 3,744 ⟶ 7,034:
"SQUAD", true;
"CONFUSE", true;
]</langsyntaxhighlight>
 
{{Out}}
Line 3,760 ⟶ 7,050:
=={{header|Oforth}}==
 
<syntaxhighlight lang="oforth">import: mapping
<lang Oforth>["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] const: ABCBlocks
 
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
const: ABCBlocks
 
: canMakeWord(w, blocks)
| i |
w isEmptyempty? ifTrue: [ true return ]
blocks size loop: i [
w first >upper blocks at(i) include(w first toUpper)? ifFalse: [ continue ]
canMakeWord( w right( w size 1 - ), blocks del(i, i) ) ifTrue: [ true return ]
]
false ;</lang>
;</syntaxhighlight>
 
{{out}}
<pre>
["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"] map(#[ ABCBlocks canMakeWord]) println.
[1, 1, 0, 1, 0, 1, 1]
</pre>
Line 3,779 ⟶ 7,073:
=={{header|OpenEdge/Progress}}==
 
<langsyntaxhighlight Progresslang="progress (Openedgeopenedge ABLabl)">FUNCTION canMakeWord RETURNS LOGICAL (INPUT pWord AS CHARACTER) FORWARD.
 
/* List of blocks */
Line 3,881 ⟶ 7,175:
RETURN TRUE.
END FUNCTION.
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,892 ⟶ 7,186:
SQUAD = yes
CONFUSE = yes
</pre>
 
=={{header|Order}}==
<syntaxhighlight lang="order">#include <order/interpreter.h>
#include <order/lib.h>
 
// Because of technical limitations, characters within a "string" must be separated by white spaces.
// For the sake of simplicity, only upper-case characters are supported here.
 
// A few lines of boiler-plate oriented programming are needed to enable character parsing and comparison.
#define ORDER_PP_TOKEN_A (A)
#define ORDER_PP_TOKEN_B (B)
#define ORDER_PP_TOKEN_C (C)
#define ORDER_PP_TOKEN_D (D)
#define ORDER_PP_TOKEN_E (E)
#define ORDER_PP_TOKEN_F (F)
#define ORDER_PP_TOKEN_G (G)
#define ORDER_PP_TOKEN_H (H)
#define ORDER_PP_TOKEN_I (I)
#define ORDER_PP_TOKEN_J (J)
#define ORDER_PP_TOKEN_K (K)
#define ORDER_PP_TOKEN_L (L)
#define ORDER_PP_TOKEN_M (M)
#define ORDER_PP_TOKEN_N (N)
#define ORDER_PP_TOKEN_O (O)
#define ORDER_PP_TOKEN_P (P)
#define ORDER_PP_TOKEN_Q (Q)
#define ORDER_PP_TOKEN_R (R)
#define ORDER_PP_TOKEN_S (S)
#define ORDER_PP_TOKEN_T (T)
#define ORDER_PP_TOKEN_U (U)
#define ORDER_PP_TOKEN_V (V)
#define ORDER_PP_TOKEN_W (W)
#define ORDER_PP_TOKEN_X (X)
#define ORDER_PP_TOKEN_Y (Y)
#define ORDER_PP_TOKEN_Z (Z)
 
#define ORDER_PP_SYM_A(...) __VA_ARGS__
#define ORDER_PP_SYM_B(...) __VA_ARGS__
#define ORDER_PP_SYM_C(...) __VA_ARGS__
#define ORDER_PP_SYM_D(...) __VA_ARGS__
#define ORDER_PP_SYM_E(...) __VA_ARGS__
#define ORDER_PP_SYM_F(...) __VA_ARGS__
#define ORDER_PP_SYM_G(...) __VA_ARGS__
#define ORDER_PP_SYM_H(...) __VA_ARGS__
#define ORDER_PP_SYM_I(...) __VA_ARGS__
#define ORDER_PP_SYM_J(...) __VA_ARGS__
#define ORDER_PP_SYM_K(...) __VA_ARGS__
#define ORDER_PP_SYM_L(...) __VA_ARGS__
#define ORDER_PP_SYM_M(...) __VA_ARGS__
#define ORDER_PP_SYM_N(...) __VA_ARGS__
#define ORDER_PP_SYM_O(...) __VA_ARGS__
#define ORDER_PP_SYM_P(...) __VA_ARGS__
#define ORDER_PP_SYM_Q(...) __VA_ARGS__
#define ORDER_PP_SYM_R(...) __VA_ARGS__
#define ORDER_PP_SYM_S(...) __VA_ARGS__
#define ORDER_PP_SYM_T(...) __VA_ARGS__
#define ORDER_PP_SYM_U(...) __VA_ARGS__
#define ORDER_PP_SYM_V(...) __VA_ARGS__
#define ORDER_PP_SYM_W(...) __VA_ARGS__
#define ORDER_PP_SYM_X(...) __VA_ARGS__
#define ORDER_PP_SYM_Y(...) __VA_ARGS__
#define ORDER_PP_SYM_Z(...) __VA_ARGS__
 
/// 8blocks_lexer (string) : Seq String -> Seq (Seq Sym)
#define ORDER_PP_DEF_8blocks_lexer ORDER_PP_FN \
(8fn (8S \
,8seq_map (8tokens_to_seq \
,8S \
) \
) \
)
 
// Keying the blocks makes filtering them way more efficient than by comparing their letters.
/// 8seq_keyed (sequence) : Seq a -> Seq (Pair Num a)
#define ORDER_PP_DEF_8seq_keyed ORDER_PP_FN \
(8fn (8S \
,8stream_to_seq (8stream_pair_with (8pair \
,8stream_of_naturals \
,8seq_to_stream (8S) \
) \
) \
) \
)
 
/// 8abc_internal (blocks, word) : Seq (Pair Num (Seq Token)) -> Seq Token -> Bool
#define ORDER_PP_DEF_8abc_internal ORDER_PP_FN \
(8fn (8B, 8W \
,8if (8seq_is_nil (8W) \
,8true \
,8lets ((8C, 8seq_head (8W)) \
(8S, 8seq_filter (8chain (8seq_exists (8same (8C)) \
,8tuple_at_1 \
) \
,8B \
) \
) \
(8T, 8seq_map (8chain (8flip (8seq_filter \
,8B \
) \
,8bin_pr (8not_eq \
,8tuple_at_0 \
) \
) \
,8S \
) \
) \
,8seq_exists (8flip (8abc_internal \
,8seq_tail (8W) \
) \
,8T \
) \
) \
) \
) \
)
 
/// 8abc (blocks, word) : Seq (String) -> String -> Bool
#define ORDER_PP_DEF_8abc ORDER_PP_FN \
(8fn (8B, 8W \
,8abc_internal (8seq_keyed (8blocks_lexer (8B)) \
,8tokens_to_seq (8W) \
) \
) \
)
 
#define ORDER_PP_DEF_8blocks ORDER_PP_CONST ( \
(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) \
)
 
ORDER_PP
(8seq_map (8step (8pair (8identity
,8abc (8blocks)
)
)
,8quote ((A)
(B A R K)
(B O O K)
(T R E A T)
(C O M M O N)
(S Q U A D)
(C O N F U S E)
)
)
)
 
</syntaxhighlight>
 
{{out}}
<pre>
((A,8true))((B A R K,8true))((B O O K,8false))((T R E A T,8true))((C O M M O N,8false))((S Q U A D,8true))((C O N F U S E,8true))
</pre>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">BLOCKS = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM";
WORDS = ["A","Bark","BOOK","Treat","COMMON","SQUAD","conFUSE"];
 
Line 3,912 ⟶ 7,376:
}
 
for (i = 1, #WORDS, printf("%s\t%d\n", WORDS[i], can_make_word(WORDS[i])));</langsyntaxhighlight>
 
Output:<pre>A 1
Line 3,921 ⟶ 7,385:
SQUAD 1
conFUSE 1</pre>
 
 
=={{header|Pascal}}==
Line 3,927 ⟶ 7,390:
{{works with|Free Pascal|2.6.2}}
 
<syntaxhighlight lang="pascal">
<lang Pascal>
#!/usr/bin/instantfpc
//program ABCProblem;
Line 3,993 ⟶ 7,456:
TestABCProblem('SQUAD');
TestABCProblem('CONFUSE');
END.</langsyntaxhighlight>
 
{{out}}
Line 4,017 ⟶ 7,480:
=={{header|Perl}}==
Recursive solution that can handle characters appearing on different blocks:
<langsyntaxhighlight lang="perl">#!/usr/bin/perl
use warnings;
use strict;
Line 4,042 ⟶ 7,505:
}
return
}</langsyntaxhighlight>
<p>Testing:
<langsyntaxhighlight lang="perl">use Test::More tests => 8;
 
my @blocks1 = qw(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM);
Line 4,057 ⟶ 7,520:
my @blocks2 = qw(US TZ AO QA);
is(can_make_word('auto', @blocks2), 1);
</syntaxhighlight>
</lang>
===Regex based alternate===
<syntaxhighlight lang="perl">#!/usr/bin/perl
 
use strict; # https://rosettacode.org/wiki/ABC_Problem
=={{header|Perl 6}}==
use warnings;
{{works with|rakudo|6.0.c}}
Blocks are stored as precompiled regexes. We do an initial pass on the blockset to include in the list only those regexes that match somewhere in the current word. Conveniently, regexes scan the word for us.
<lang perl6>multi can-spell-word(Str $word, @blocks) {
my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
can-spell-word $word.uc.comb.list, @regex;
}
multi can-spell-word([$head,*@tail], @regex) {
for @regex -> $re {
if $head ~~ $re {
return True unless @tail;
return False if @regex == 1;
return True if can-spell-word @tail, list @regex.grep: * !=== $re;
}
}
False;
}
my @b = <BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM>;
for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
say "$_ &can-spell-word($_, @b)";
}</lang>
{{out}}
<pre>A True
BaRK True
BOoK False
tREaT True
COmMOn False
SqUAD True
CoNfuSE True</pre>
 
printf "%30s %s\n", $_, can_make_word( $_,
=={{header|Phix}}==
'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM' )
for qw( A BARK BOOK TREAT COMMON SQUAD CONFUSE );
 
sub can_make_word
<lang Phix>
{
-- Here is my recursive solution which also solves the extra problems on the discussion page:
my ($word, $blocks) = @_;
 
my $letter = chop $word or return 'True';
sequence blocks = {"BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
can_make_word( $word, $` . $' ) eq 'True' and return 'True'
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"}
while $blocks =~ /\w?$letter\w?/gi;
 
return 'False';
sequence words = {"","A","BarK","BOOK","TrEaT","COMMON","SQUAD","CONFUSE"}
}</syntaxhighlight>
 
{{out}}
--sequence blocks = {"US","TZ","AO","QA"}
<pre>
--sequence words = {"AuTO"}
A True
 
BARK True
--sequence blocks = {"AB","AB","AC","AC"}
BOOK False
--sequence words = {"abba"}
TREAT True
COMMON False
SQUAD True
CONFUSE True
</pre>
 
=={{header|Phix}}==
sequence used = repeat(0,length(blocks))
Recursive solution which also solves the extra problems on the discussion page.
 
<!--<syntaxhighlight lang="phix">-->
function ABC_Solve(sequence word, integer idx)
<span style="color: #004080;">sequence</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">words</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">used</span>
integer ch
integer res = 0
<span style="color: #008080;">function</span> <span style="color: #000000;">ABC_Solve</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
if idx>length(word) then
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
res = 1
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
else
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
ch = word[idx]
<span style="color: #000080;font-style:italic;">-- or: res = length(word)&gt;0 -- (if "" -&gt; false desired)</span>
for k=1 to length(blocks) do
<span style="color: #008080;">else</span>
if used[k]=0
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">word</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span>
and find(ch,blocks[k]) then
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
used[k] = 1
<span style="color: #008080;">if</span> <span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">0</span>
res = ABC_Solve(word,idx+1)
<span style="color: #008080;">and</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">then</span>
used[k] = 0
<span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
if res then exit end if
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ABC_Solve</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
end if
<span style="color: #000000;">used</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
end for
<span style="color: #008080;">if</span> <span style="color: #000000;">res</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
 
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
constant TF = {"False","True"}
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
procedure ABC_Problem()
for i=1 to length(words) do
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{{</span><span style="color: #008000;">"BO"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"XK"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"DQ"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CP"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"NA"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"GT"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"RE"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"TG"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"QD"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"FS"</span><span style="color: #0000FF;">,</span>
printf(1,"%s: %s\n",{words[i],TF[ABC_Solve(upper(words[i]),1)+1]})
<span style="color: #008000;">"JW"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"HU"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"VI"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AN"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"OB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"ER"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"FS"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"LY"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"PC"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"ZM"</span><span style="color: #0000FF;">},</span>
end for
<span style="color: #0000FF;">{</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"A"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"BarK"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"BOOK"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"TrEaT"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"COMMON"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"SQUAD"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CONFUSE"</span><span style="color: #0000FF;">}},</span>
if getc(0) then end if
<span style="color: #0000FF;">{{</span><span style="color: #008000;">"US"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"TZ"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AO"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"QA"</span><span style="color: #0000FF;">},{</span><span style="color: #008000;">"AuTO"</span><span style="color: #0000FF;">}},</span>
end procedure
<span style="color: #0000FF;">{{</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AC"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AC"</span><span style="color: #0000FF;">},{</span><span style="color: #008000;">"abba"</span><span style="color: #0000FF;">}}}</span>
 
ABC_Problem()
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
 
<span style="color: #0000FF;">{</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span><span style="color: #000000;">words</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
</lang>
<span style="color: #000000;">used</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s: %t\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">],</span><span style="color: #000000;">ABC_Solve</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">upper</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]),</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
: Truetrue
A: Truetrue
BarK: Truetrue
BOOK: Falsefalse
TrEaT: Truetrue
COMMON: Falsefalse
SQUAD: Truetrue
CONFUSE: Truetrue
AuTO: true
abba: true
</pre>
 
=={{header|PHP}}==
 
<syntaxhighlight lang="php">
<lang PHP>
<?php
$words = array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse");
Line 4,184 ⟶ 7,634:
echo canMakeWord($word) ? "True" : "False";
echo "\r\n";
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,195 ⟶ 7,645:
Confuse: True
</pre>
 
=={{header|Picat}}==
Showing both a Picat style version (check_word/2) and a Prolog style recursive version (check_word2/2). go2/0 generates all possible solutions (using fail/0) to backtrack.
<syntaxhighlight lang="picat">go =>
test_it(check_word),
test_it(check_word2),
nl.
 
% Get all possible solutions (via fail)
go2 ?=>
test_version(check_word2),
fail,
nl.
go2 => true.
 
%
% Test a version.
%
test_it(Pred) =>
println(testing=Pred),
Blocks = findall([A,B], block(A,B)),
Words = findall(W,word(W)),
foreach(Word in Words)
println(word=Word),
( call(Pred,Word,Blocks) ; println("Cannot make word.")),
nl
end,
nl.
 
%
% Picat style: Using nth/3 for getting the chars
%
check_word(Word, Blocks) =>
WordC = atom_chars(Word), % convert atom to string
WordLen = length(WordC),
X = new_list(WordLen),
Pos = new_list(WordLen),
foreach(I in 1..WordLen)
% find a character at the specific position
nth(X[I],Blocks,XI),
nth(Pos[I],XI, WordC[I])
end,
alldiff(X), % ensure unique selection
foreach(I in 1..WordLen)
println([WordC[I], Blocks[X[I]]])
end,
nl.
 
%
% Prolog style (recursive) version using select/3.
% (where we don't have to worry about duplicate blocks)
%
check_word2(Word, Blocks) :-
pick_block(atom_chars(Word),Blocks,[],X),
println(X).
 
pick_block([], _,Res,Res).
pick_block([C|WordRest], Blocks, Res1,[Block|Res]) :-
% pick (non-deterministically) one of the blocks
select(Block,Blocks,BlocksRest),
membchk(C,Block),
pick_block(WordRest,BlocksRest,Res1,Res).
 
%
% alldiff(L):
% ensure that all elements in L are different
%
alldiff([]).
alldiff([_]).
alldiff([H|T]) :-
neq(H,T),
alldiff(T).
 
neq(_,[]).
neq(X,[H|T]) :-
X != H,
neq(X,T).
 
% The words to check.
word(a).
word(bark).
word(book).
word(treat).
word(common).
word(squad).
word(confuse).
word(auto).
word(abba).
word(coestablishment).
word(schoolmastering).
 
% The blocks
block(b,o).
block(x,k).
block(d,q).
block(c,p).
block(n,a).
block(g,t).
block(r,e).
block(t,g).
block(q,d).
block(f,s).
block(j,w).
block(h,u).
block(v,i).
block(a,n).
block(o,b).
block(e,r).
block(f,s).
block(l,y).
block(p,c).
block(z,m).
</syntaxhighlight>
 
{{out}}
<pre>
testing = check_word
word = a
[a,na]
 
word = bark
[b,bo] [a,na] [r,re] [k,xk]
 
word = book
Cannot make word.
 
word = treat
[t,gt] [r,re] [e,er] [a,na] [t,tg]
 
word = common
Cannot make word.
 
word = squad
[s,fs] [q,dq] [u,hu] [a,na] [d,qd]
 
word = confuse
[c,cp] [o,bo] [n,na] [f,fs] [u,hu] [s,fs] [e,re]
 
word = auto
[a,na] [u,hu] [t,gt] [o,bo]
 
word = abba
[a,na] [b,bo] [b,ob] [a,an]
 
word = coestablishment
[c,cp] [o,bo] [e,re] [s,fs] [t,gt] [a,na] [b,ob] [l,ly] [i,vi] [s,fs] [h,hu] [m,zm] [e,er] [n,an] [t,tg]
 
word = schoolmastering
[s,fs] [c,cp] [h,hu] [o,bo] [o,ob] [l,ly] [m,zm] [a,na] [s,fs] [t,gt] [e,re] [r,er] [i,vi] [n,an] [g,tg]
 
testing = check_word2
word = a
[na]
 
word = bark
[bo,na,re,xk]
 
word = book
Cannot make word.
 
word = treat
[gt,re,er,na,tg]
 
word = common
Cannot make word.
 
word = squad
[fs,dq,hu,na,qd]
 
word = confuse
[cp,bo,na,fs,hu,fs,re]
 
word = auto
[na,hu,gt,bo]
 
word = abba
[na,bo,ob,an]
 
word = coestablishment
[cp,bo,re,fs,gt,na,ob,ly,vi,fs,hu,zm,er,an,tg]
 
word = schoolmastering
[fs,cp,hu,bo,ob,ly,zm,na,fs,gt,re,er,vi,an,tg]</pre>
 
=={{header|PicoLisp}}==
Mapping and recursion.
<syntaxhighlight lang="picolisp">(setq *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)
Line 4,230 ⟶ 7,863:
(println Word (abc Word *Blocks) (abcR Word *Blocks)) )
(bye)</langsyntaxhighlight>
 
=={{header|PL/I}}==
===version 1===
<langsyntaxhighlight lang="pli">ABC: procedure options (main); /* 12 January 2014 */
 
declare word character (20) varying, blocks character (200) varying initial
Line 4,247 ⟶ 7,880:
flag = true;
tblocks = blocks;
do i = 1 to length(word);
while(flag = true);
ch = substr(word, i, 1);
k = index(tblocks, uppercase(ch));
Line 4,258 ⟶ 7,892:
end;
 
end ABC;</langsyntaxhighlight>
<pre>
A true
Line 4,268 ⟶ 7,902:
CONFUSE true
</pre>
 
===version 2===
<langsyntaxhighlight lang="pli">*process source attributes xref or(!) options nest;
abc: Proc Options(main);
/* REXX --------------------------------------------------------------
Line 4,389 ⟶ 8,024:
End;
 
End;</langsyntaxhighlight>
{{out}}
<pre>'$' cannot be spelt.
Line 4,399 ⟶ 8,034:
'SQUAD' can be spelt in 8 ways.
'CONFUSE' can be spelt in 32 ways.</pre>
 
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
 
/* ABC PROBLEM ON $-TERMINATED STRING */
CAN$MAKE$WORD: PROCEDURE (STRING) BYTE;
DECLARE STRING ADDRESS, CHAR BASED STRING BYTE;
DECLARE CONST$BLOCKS DATA
('BOKXDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM');
DECLARE I BYTE, BLOCKS (40) BYTE;
DO I=0 TO 39; /* MAKE COPY OF BLOCKS */
BLOCKS(I) = CONST$BLOCKS(I);
END;
STEP: DO WHILE CHAR <> '$';
DO I=0 TO 39; /* FIND BLOCK WITH CURRENT CHAR */
IF BLOCKS(I) = CHAR THEN DO; /* FOUND IT */
BLOCKS(I) = 0; /* CLEAR OUT BOTH LETTERS ON BLOCK */
BLOCKS(I XOR 1) = 0;
STRING = STRING + 1;
GO TO STEP; /* NEXT CHARACTER */
END;
END;
RETURN 0; /* NO BLOCK WITH LETTER */
END;
RETURN 1; /* WE FOUND THEM ALL */
END CAN$MAKE$WORD;
 
/* CP/M BDOS CALL */
BDOS: PROCEDURE (FN, ARG);
DECLARE FN BYTE, ARG ADDRESS;
GO TO 5;
END BDOS;
 
PRINT: PROCEDURE (STRING);
DECLARE STRING ADDRESS;
CALL BDOS(9, STRING);
END PRINT;
 
/* TEST SEVERAL STRINGS */
DECLARE TEST (7) ADDRESS, I BYTE;
TEST(0) = .'A$';
TEST(1) = .'BARK$';
TEST(2) = .'BOOK$';
TEST(3) = .'TREAT$';
TEST(4) = .'COMMON$';
TEST(5) = .'SQUAD$';
TEST(6) = .'CONFUSE$';
 
DO I = 0 TO LAST(TEST);
CALL PRINT(TEST(I));
CALL PRINT(.': $');
IF CAN$MAKE$WORD(TEST(I))
THEN CALL PRINT(.'YES$');
ELSE CALL PRINT(.'NO$');
CALL PRINT(.(13,10,'$'));
END;
 
CALL BDOS(0,0);
EOF</syntaxhighlight>
{{out}}
<pre>A: YES
BARK: YES
BOOK: NO
TREAT: YES
COMMON: NO
SQUAD: YES
CONFUSE: YES</pre>
 
=={{header|PowerBASIC}}==
Works with PowerBASIC 6 Console Compiler
 
<langsyntaxhighlight PowerBASIClang="powerbasic">#COMPILE EXE
#DIM ALL
'
Line 4,558 ⟶ 8,263:
END IF
END FUNCTION
</syntaxhighlight>
</lang>
{{out}}
<pre>$ FALSE
Line 4,572 ⟶ 8,277:
 
=={{header|PowerShell}}==
<langsyntaxhighlight lang="powershell"><#
.Synopsis
ABC Problem
Line 4,688 ⟶ 8,393:
{
test-blocks -testword $word -Verbose
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,754 ⟶ 8,459:
Works with SWI-Prolog 6.5.3
 
<langsyntaxhighlight Prologlang="prolog">abc_problem :-
maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).
 
Line 4,776 ⟶ 8,481:
( select([H, _], L, L1); select([_, H], L, L1)),
can_makeword(L1, T).
</syntaxhighlight>
</lang>
{{out}}
<pre> ?- abc_problem.
Line 4,797 ⟶ 8,502:
{{works with|SWI Prolog 7}}
 
<langsyntaxhighlight Prologlang="prolog">:- use_module([ library(chr),
abathslib(protelog/composer) ]).
 
Line 4,814 ⟶ 8,519:
%% These rules, removing remaining constraints from the store, are just cosmetic:
'clean up blocks' @ word_built \ block(_) <=> true.
'word was built' @ word_built <=> true.</langsyntaxhighlight>
 
 
Demonstration:
 
<langsyntaxhighlight Prologlang="prolog">?- can_build_word("A").
true.
?- can_build_word("BARK").
Line 4,832 ⟶ 8,537:
true.
?- can_build_word("CONFUSE").
true.</langsyntaxhighlight>
 
=={{header|PureBasic}}==
===PureBasic: Iterative===
<langsyntaxhighlight lang="purebasic">EnableExplicit
#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
 
Procedure.s can_make_word(word.s)
Define letters.s letters = #LETTERS, buffer.s
Define.i index1.i, index2.i
Define.b match.b
For index1=1 To Len(word)
index2=1 : match=#False
Line 4,867 ⟶ 8,572:
PrintN(can_make_word("SqUAD"))
PrintN(can_make_word("COnFUSE"))
Input()</langsyntaxhighlight>
 
===PureBasic: Recursive===
<syntaxhighlight lang="purebasic">#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
<lang purebasic>Define.i
#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
 
Macro test(t)
Line 4,889 ⟶ 8,594:
test("a") : test("BaRK") : test("BOoK") : test("TREAt")
test("cOMMON") : test("SqUAD") : test("COnFUSE")
Input()</langsyntaxhighlight>
{{out}}
<pre>a = True
Line 4,902 ⟶ 8,607:
 
===Python: Iterative, with tests===
<langsyntaxhighlight lang="python">
'''
Note that this code is broken, e.g., it won't work when
Line 4,971 ⟶ 8,676:
["", "a", "baRk", "booK", "treat",
"COMMON", "squad", "Confused"]))
</syntaxhighlight>
</lang>
 
{{out}}
Line 4,977 ⟶ 8,682:
 
===Python: Recursive===
<langsyntaxhighlight 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):
Line 5,001 ⟶ 8,706:
if __name__ == '__main__':
for word in [''] + 'A BARK BoOK TrEAT COmMoN SQUAD conFUsE'.split():
print('Can we spell %9r? %r' % (word, abc(word)))</langsyntaxhighlight>
 
{{out}}
Line 5,014 ⟶ 8,719:
 
===Python: Recursive, telling how===
<langsyntaxhighlight lang="python">def mkword(w, b):
if not w: return []
 
Line 5,029 ⟶ 8,734:
 
for w in ", A, bark, book, treat, common, SQUAD, conFUsEd".split(', '):
print '\'' + w + '\'' + ' ->', abc(w, blocks)</langsyntaxhighlight>
 
{{out}}
Line 5,043 ⟶ 8,748:
'conFUsEd' -> ['CP', 'BO', 'NA', 'FS', 'HU', 'FS', 'RE', 'DQ']
</pre>
 
=={{header|q}}==
The possibility of ‘backtracking’, discussed in the FORTRAN solution above (and not tested by the example set) makes this a classic tree search: wherever there is a choice of blocks from which to pick the next letter, each choice must be tested.
<syntaxhighlight lang="q">BLOCKS:string`BO`XK`DQ`CP`NA`GT`RE`TG`QD`FS`JW`HU`VI`AN`OB`ER`FS`LY`PC`ZM
WORDS:string`A`BARK`BOOK`TREAT`COMMON`SQUAD`CONFUSE
 
cmw:{[s;b] / [str;blocks]
$[0=count s; 1b; / empty string
not any found:any each b=s 0; 0b; / cannot proceed
any(1_s).z.s/:b(til count b)except/:where found] }</syntaxhighlight>
{{out}}
<syntaxhighlight lang="q">q)WORDS cmw\:BLOCKS
1101011b</syntaxhighlight>
The first expression tests whether the string <code>s</code> is empty. If so, the result is true. This matches two cases: either the string is empty and can be made from any set of blocks; or all its letters have been matched and there is nothing more to check.
 
The second expression looks in the available blocks <code>b</code> for the first letter of <code>s</code>: the boolean vector <code>found</code> flags any hits. If there are none, the result is false: the string cannot be completed from the available blocks.
 
The last line searches further. The expression <code>til count b</code> indexes the remaining blocks; and <code>where found</code> are the indexes that have the next letter. The derived function <code>except/:</code> yields a list: each item is a copy of the list of indexes <code>til count b</code>, with one of the <code>found</code> indexes removed. The list of blocks <code>b</code> is applied to each of these index lists; the result is multiple versions of the list of blocks; each has had a different block removed. The <code>cmw</code> function is applied to each of these with the truncated string <code>1_s</code>. (The expression <code>.z.s</code> refers to the currently-running function, so <code>cmw</code> does not need to know its own name.) The result of these calls is a boolean vector; aggregator <code>any</code> reports if any have succeeded in completing the string.
 
To meet the requirement for case-insensitivity and to display the results, apply the above within a wrapper.
<syntaxhighlight lang="q">Words:string`A`bark`BOOK`Treat`COMMON`squad`CONFUSE
cmwi:{(`$x), `false`true cmw . upper each(x;y) }</syntaxhighlight>
{{out}}
<syntaxhighlight lang="q">q)Words cmwi\:BLOCKS
A true
bark true
BOOK false
Treat true
COMMON false
squad true
CONFUSE true</syntaxhighlight>
* [https://code.kx.com/q/ref/ Language Reference]
* [https://code.kx.com/q/learn/pb/abc-problem/ The Q Playbook: ABC problem – analysis]
 
=={{header|Quackery}}==
 
===Iterative, without backtracking===
 
See note in the FORTRAN solution and elsewhere re: backtracking. Fails the ABBA test, see "Greedy Algorithm" in the discussion for this page.
 
This solution assumes the constraint that if a letter appears on more than one block those blocks are identical (as in the example set) so backtracking is not required.
 
<syntaxhighlight lang="quackery">[ $ "BOXKDQCPNAGTRETGQDFS"
$ "JWHUVIANOBERFSLYPCZM"
join ] constant is blocks ( --> $ )
 
[ -2 &
tuck pluck drop
swap pluck drop ] is remove2 ( $ n --> $ )
 
[ iff [ say "True" ]
else [ say "False" ] ] is echotruth ( b --> )
 
[ true blocks rot
witheach
[ upper over find
2dup swap found
iff remove2
else
[ drop dip not
conclude ] ]
drop echotruth ] is can_make_word ( $ --> )</syntaxhighlight>
 
'''Testing in the Quackery shell:'''
 
<pre>/O> $ "A" can_make_word
...
True
Stack empty.
 
/O> $ "BARK" can_make_word
...
True
Stack empty.
 
/O> $ "BOOK" can_make_word
...
False
Stack empty.
 
/O> $ "TREAT" can_make_word
...
True
Stack empty.
 
/O> $ "COMMON" can_make_word
...
False
Stack empty.
 
/O> $ "SQUAD" can_make_word
...
True
Stack empty.
 
/O> $ "CONFUSE" can_make_word
...
True
Stack empty.</pre>
 
===Recursive, with backtracking===
 
See note in the FORTRAN solution and elsewhere re: backtracking. Passes the ABBA test, see "Greedy Algorithm" in the discussion for this page.
 
This solution does not assume the constraint that if a letter appears on more than one block those blocks are identical (as in the example set) so backtracking is required.
 
<syntaxhighlight lang="quackery">[ ' [ 0 ] swap
witheach
[ over -1 peek
+ join ]
behead drop ] is accumulate ( [ --> [ )
 
[ [] swap
witheach
[ swap dip
[ over + ]
swap join ]
nip ] is add ( n [ --> [ )
 
[ [] unrot
[ 2dup find
2dup swap
found while
1+ split
swap size
dip rot join
unrot again ]
2drop drop
accumulate
-1 swap add ] is findall ( x [ --> [ )
 
[ iff [ say "True" ]
else [ say "False" ] ] is echotruth ( b --> )
 
[ $ "BOXKDQCPNAGTRETGQDFS"
$ "JWHUVIANOBERFSLYPCZM"
join ] constant is blocks ( --> $ )
 
[ -2 &
tuck pluck drop
swap pluck drop ] is remove2 ( $ n --> $ )
 
forward is (abc)
 
[ dup [] = if bail
behead upper
dip over swap findall
witheach
[ dip over
remove2
over (abc) ]
2drop ] resolves (abc) ( $ $ --> )
 
[ blocks swap
2 backup (abc)
bailed dup
if [ dip 2drop ]
echotruth ] is can_make_word ( $ --> )</syntaxhighlight>
'''Testing in the Quackery shell:'''
Identical to iterative solution above.
 
=={{header|R}}==
Line 5,049 ⟶ 8,914:
Vectorised function for R which will take a character vector and return a logical vector of equal length with TRUE and FALSE as appropriate for words which can/cannot be made with the blocks.
 
<langsyntaxhighlight Rlang="r">blocks <- rbind(c("B","O"),
c("X","K"),
c("D","Q"),
Line 5,091 ⟶ 8,956:
"COMMON",
"SQUAD",
"CONFUSE"))</langsyntaxhighlight>
 
{{out}}
Line 5,099 ⟶ 8,964:
===Without recursion===
Second version without recursion and giving every unique combination of blocks for each word:
<langsyntaxhighlight Rlang="r">canMakeNoRecursion <- function(x) {
x <- toupper(x)
charList <- strsplit(x, character(0))
Line 5,119 ⟶ 8,984:
"COMMON",
"SQUAD",
"CONFUSE"))</langsyntaxhighlight>
{{out}}
<pre>$A
Line 5,203 ⟶ 9,068:
So '(can-make-word? "")' is true for me.
 
<langsyntaxhighlight lang="racket">#lang racket
(define block-strings
(list "BO" "XK" "DQ" "CP" "NA"
Line 5,245 ⟶ 9,110:
(check-false (can-make-word? "COMMON"))
(check-true (can-make-word? "SQUAD"))
(check-true (can-make-word? "CONFUSE")))</langsyntaxhighlight>
 
{{out}}
Line 5,256 ⟶ 9,121:
Can we make: "SQUAD" ? yes
Can we make: "CONFUSE"? yes</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|rakudo|6.0.c}}
Blocks are stored as precompiled regexes. We do an initial pass on the blockset to include in the list only those regexes that match somewhere in the current word. Conveniently, regexes scan the word for us.
<syntaxhighlight lang="raku" line>multi can-spell-word(Str $word, @blocks) {
my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
can-spell-word $word.uc.comb.list, @regex;
}
multi can-spell-word([$head,*@tail], @regex) {
for @regex -> $re {
if $head ~~ $re {
return True unless @tail;
return False if @regex == 1;
return True if can-spell-word @tail, list @regex.grep: * !=== $re;
}
}
False;
}
my @b = <BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM>;
for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
say "$_ &can-spell-word($_, @b)";
}</syntaxhighlight>
{{out}}
<pre>A True
BaRK True
BOoK False
tREaT True
COmMOn False
SqUAD True
CoNfuSE True</pre>
 
=={{header|RapidQ}}==
<langsyntaxhighlight lang="vb">dim Blocks as string
dim InWord as string
 
Line 5,284 ⟶ 9,183:
Blocks = "BO, XK, DQ, CP, NA, GT, RE, TG, QD, FS, JW, HU, VI, AN, OB, ER, FS, LY, PC, ZM"
showmessage "Can make: " + InWord + " = " + iif(CanMakeWord(InWord, Blocks), "True", "False")
</syntaxhighlight>
</lang>
{{out}}
<pre>Can make: A = TRUE
Line 5,294 ⟶ 9,193:
Can make: CONFUSE = TRUE
</pre>
 
=={{header|Red}}==
<syntaxhighlight lang="red">Red []
test: func [ s][
p: copy "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
forever [
if 0 = length? s [ return 'true ] ;; if string cleared, all chars found/removed
if tail? p [ return 'false ] ;; if at end of search block - not found
rule: reduce [ first p '| second p] ;; construct parse rule from string
either parse s [ to rule remove rule to end ] [ ;; remove found char from string
remove/part p 2 ;;character found , remove block
p: head p ;;start from remaining string at beginning aka head
] [ p: skip p 2 ] ;; else move to next block
]
]
foreach word split {A bark book TrEAT COmMoN SQUAD conFUsE} space [
print reduce [ pad copy word 8 ":" test word]
]
</syntaxhighlight>
{{out}}
<pre>
A : true
bark : true
book : false
TrEAT : true
COmMoN : false
SQUAD : true
conFUsE : true
</pre>
 
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
= <Each Show (<Blocks>) <Words>>;
};
 
Each {
s.F (e.Arg) = ;
s.F (e.Arg) t.I e.R = <Mu s.F t.I e.Arg> <Each s.F (e.Arg) e.R>;
};
 
Show {
(e.Word) e.Blocks = <Prout e.Word ': ' <CanMakeWord (e.Word) e.Blocks>>;
};
 
Blocks {
= ('BO') ('XK') ('DQ') ('CP') ('NA')
('GT') ('RE') ('TG') ('QD') ('FS')
('JW') ('HU') ('VI') ('AN') ('OB')
('ER') ('FS') ('LY') ('PC') ('ZM');
};
 
Words {
= ('A') ('BARK') ('BOOK') ('TREAT')
('common') ('squad') ('CoNfUsE');
};
 
CanMakeWord {
(e.Word) e.Blocks = <CanMakeWord1 (<Upper e.Word>) e.Blocks>;
}
 
CanMakeWord1 {
() e.Blocks = T;
(s.Ltr e.Word) e.Blocks1 (e.X s.Ltr e.Y) e.Blocks2
= <CanMakeWord1 (e.Word) e.Blocks1 e.Blocks2>;
(e.Word) e.Blocks = F;
};</syntaxhighlight>
{{out}}
<pre>A: T
BARK: T
BOOK: F
TREAT: T
common: F
squad: T
CoNfUsE: T</pre>
 
=={{header|REXX}}==
===version 1===
<langsyntaxhighlight lang="rexx">/*REXX pgm determinesfinds if words can be spelt from a pool of toy blocks (each having 2 letters)*/
list= 'A bark bOOk treat common squaD conFuse' /*words can be: upper/lower/mixed 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 a list of some words.*/
call spell word(list, k) /*display if word can be spelt (or not)*/
end /*k*/ /* [↑] tests each word in the list. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
spell: procedure expose blocks; parse arg oxx 1 x /*uppercaseARG uppercases the word to be spelledspelt. */
upper blocks x; L=length(x) L= length(x); @.= 0 /*uppercaseget length of the lettersword onto thebe blocksspelt. */
@.=0 do try=1 for L; z= blocks; upper z /*use [↓]a fresh copy attempt to spellof the word. "Z" blocks.*/
do tryn=1 for L; zy=blocks substr(x, n, 1) /*useattempt aanother freshletter copy ofin the word. "Z" blocks.*/
do @.n=1 for L; y=substrpos(xy, nz, 1 + @.n); /*attempt another blockif letter@.n==0 then leave /*not found? Try again*/
@.nz=pos overlay(y' ', z, 1+@.n); if @.n==0 then leave /*notmutate found?the Trytoy againblock ───► a onesy. */
z=overlay(' ', z,do @.n)q=1 for words(z); if length(word(z,q))==1 then z= delword(z, /*mutateq, the toy block ───► a onesy. */1)
end /*q*/ /* [↑] elide any existing onesy block.*/
do k=1 for words(blocks); if length(word(z,k))==1 then z=delword(z,k,1)
if n==L then end /*k*/ leave try /*was [↑] last elideletter anyused existingin onesythe block.spelling?*/
end if /*n==L*/ then leave try /*was the[↑] lastend letterof spelled?a toy block usage. */
end end /*ntry*/ /* [↑] end of a toy"TRY" block usagepermute. */
say right( arg(1), 30) right( word( "can't can", (n==L) + 1), 6) 'be spelt.'
end /*try*/ /* [↑] end of a "TRY" permute. */
return</syntaxhighlight>
say right(ox, 30) right( word( "can't can", (n==L) +1), 6) 'be spelt.'
{{out|output|text=&nbsp; when using the default inputs:}}
return</lang>
'''output:''' &nbsp; &nbsp; [Spelling note: &nbsp; "spelt" is an alternate version of "spelled".]
<pre>
A can be spelt.
Line 5,331 ⟶ 9,303:
 
===version 2===
<langsyntaxhighlight lang="rexx">/* REXX ---------------------------------------------------------------
* 10.01.2014 Walter Pachl counts the number of possible ways
* 12.01.2014 corrected date and output
Line 5,433 ⟶ 9,405:
used.w=1
End
Return 1</langsyntaxhighlight>
{{out}}
<pre>'' cannot be spelt.
Line 5,514 ⟶ 9,486:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">Blocks = [ :BO, :XK, :DQ, :CP, :NA, :GT, :RE, :TG, :QD, :FS, :JW, :HU, :VI, :AN, :OB, :ER, :FS, :LY, :PC, :ZM ]
Words = [ :A, :BARK, :BOOK, :TREAT, :COMMON, :SQUAD, :CONFUSE ]
 
Line 5,537 ⟶ 9,509:
if found = false return false ok
next
return true</langsyntaxhighlight>
{{Out}}
<pre>
Line 5,554 ⟶ 9,526:
>>> can_make_word("CONFUSE")
True
</pre>
 
=={{header|RPL}}==
Recursion provides an easy way to solve the task. RPL can manage recursive functions, provided that they don't use local variables. All the data must then be managed in the stack, which makes the code somehow difficult to read: one third of the words used by the program are about stack handling: <code>DUP</code>, <code>DROP(N)</code>, <code>PICK</code>, <code>SWAP</code>, <code>ROLL</code> etc.
Recursive search is here systematic: the program does check that ABBA can be written with 2 cubes AB and 2 cubes AC, whatever their order.
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ SWAP LIST→ → n
≪ n DUP 2 + ROLL - 1 + ROLL n ROLLD
n 1 - →LIST SWAP
≫ ≫ ''''PICKL'''' STO
≪ 1 1 SUB → cubes letter
≪ { } 1 cubes SIZE '''FOR''' j
'''IF''' cubes j GET letter POS
'''THEN''' j + '''END NEXT'''
≫ ≫ ''''GetCubeList'''' STO
DUP2 '''GetCubeList'''
'''IF''' DUP SIZE '''THEN'''
'''IF''' OVER SIZE 1 ==
'''THEN''' 3 DROPN 1
'''ELSE'''
SWAP 2 OVER SIZE SUB
0 SWAP ROT DUP SIZE
'''DO'''
DUP2 GET
6 PICK SWAP '''PICKL''' DROP
4 PICK '''ABC?'''
5 ROLL OR 4 ROLLD
1 -
'''UNTIL''' DUP NOT '''END'''
3 DROPN SWAP DROP
'''END'''
'''ELSE''' 3 DROPN 0 '''END'''
≫ ''''ABC?'''' STO
≪ 1 Words SIZE '''FOR''' w
Words w GET Cubes Words w GET '''ABC?'''
": true" ": false" IFTE + '''NEXT'''
≫ ''''TASK'''' STO
|
'''PICKL''' ''( { x1..xm..xn } m -- { x1..xn } xm )''
put selected item at bottom of stack
make a new list with the rest of the stack
'''GetCubeList''' ''( { cubes } "word" -- { match_cubes } )''
Scan cubes
Retain those matching with 1st letter of word
'''ABC?''' ''( { cubes } "word" -- boolean )''
Get the list of cubes matching the 1st letter
if list not empty
if word size = 1 letter
return true
else
initialize stack:
( {cubes} false "ord" { CubeList } index -- )
repeat
get a matching cube index
remove cube from cube list
search cubes for "ord"
update boolean value
back to previous cube index
until all matching cubes checked
clear stack except boolean value
return false if no matching cube
|}
 
{{in}}
<pre>
{ "BO" "XK" "DQ" "CP" "NA" "GT" "RE" "TG" "QD" "FS" "JW" "HU" "VI" "AN" "OB" "ER" "FS" "LY" "PC" "ZM" } 'Cubes' STO
{ "A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE" } 'Words' STO
TASK
{ "AB" "AB" "AC" "AC" } "ABBA" ABC?
</pre>
{{out}}
<pre>
8: "A: true"
7: "BARK: true"
6: "BOOK: false"
5: TREAT: true"
4: "COMMON: false"
3: "SQUAD: true"
2: "CONFUSE: true"
1: 1
</pre>
 
=={{header|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.
<langsyntaxhighlight lang="ruby">words = %w(A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE) << ""
 
words.each do |word|
Line 5,565 ⟶ 9,638:
puts "#{word.inspect}: #{res}"
end
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 5,579 ⟶ 9,652:
 
=={{header|Run BASIC}}==
<langsyntaxhighlight lang="unbasic">blocks$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
makeWord$ = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse"
b = int((len(blocks$) /3) + 1)
Line 5,603 ⟶ 9,676:
print wrd$;chr$(9);
if n = len(wrd$) then print " True" else print " False"
next i</langsyntaxhighlight>
<pre>A True
BARK True
Line 5,614 ⟶ 9,687:
=={{header|Rust}}==
This implementation uses a backtracking search.
<langsyntaxhighlight lang="rust">use std::iter::repeat;
 
fn rec_can_make_word(index: usize, word: &str, blocks: &[&str], used: &mut[bool]) -> bool {
Line 5,643 ⟶ 9,716:
}
}
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 5,656 ⟶ 9,729:
 
=={{header|Scala}}==
{{libheader|Scala}}<langsyntaxhighlight Scalalang="scala">object AbcBlocks extends App {
 
protected class Block(face1: Char, face2: Char) {
Line 5,705 ⟶ 9,778:
 
words.foreach(w => println(s"$w can${if (isMakeable(w, blocks)) " " else "not "}be made."))
}</langsyntaxhighlight>
 
=={{header|Scheme}}==
In R5RS:
<langsyntaxhighlight lang="scheme">(define *blocks*
'((#\B #\O) (#\X #\K) (#\D #\Q) (#\C #\P) (#\N #\A)
(#\G #\T) (#\R #\E) (#\T #\G) (#\Q #\D) (#\F #\S)
Line 5,749 ⟶ 9,822:
(display word)
(newline))
*words*)</langsyntaxhighlight>
{{out}}
<pre>
Line 5,762 ⟶ 9,835:
 
=={{header|Seed7}}==
<langsyntaxhighlight lang="seed7">$ include "seed7_05.s7i";
 
const func boolean: canMakeWords (in array string: blocks, in string: word) is func
Line 5,795 ⟶ 9,868:
writeln(word rpad 10 <& canMakeWords(word));
end for;
end func;</langsyntaxhighlight>
 
{{out}}
Line 5,809 ⟶ 9,882:
</pre>
 
=={{header|SenseTalk}}==
<syntaxhighlight lang="sensetalk">function CanMakeWord word
 
put [
("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")
] into blocks
repeat with each character letter of word
put False into found
repeat with each item block of blocks by reference
if item 1 of block is letter ignoring case or item 2 of block is letter ignoring case
delete block
put True into found
exit repeat
end if
end repeat
if found is False
return False
end if
end repeat
return True
end CanMakeWord</syntaxhighlight>
 
<syntaxhighlight lang="sensetalk">repeat with each item word in [
"A",
"BARK",
"BOOK",
"TREAT",
"COMMON",
"SQUAD",
"CONFUSE"
]
put CanMakeWord(word)
end repeat</syntaxhighlight>
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program ABC_problem;
blocks := ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"];
 
words := ["A","BARK","BOOK","treat","common","Squad","CoNfUsE"];
 
loop for word in words do
print(rpad(word, 8), can_make_word(word, blocks));
end loop;
 
proc can_make_word(word, blocks);
loop for letter in word do
if exists block = blocks(i) | to_upper(letter) in block then
blocks(i) := "";
else
return false;
end if;
end loop;
return true;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>A #T
BARK #T
BOOK #F
treat #T
common #F
Squad #T
CoNfUsE #T</pre>
=={{header|SequenceL}}==
===Recursive Search Version===
<langsyntaxhighlight lang="sequencel">import <Utilities/Conversion.sl>;
import <Utilities/Sequence.sl>;
 
Line 5,839 ⟶ 9,997:
letter when ascii >= 65 and ascii <= 90
else
intToAscii(ascii - 32);</langsyntaxhighlight>
 
{{out}}
Line 5,854 ⟶ 10,012:
 
===RegEx Version ===
<langsyntaxhighlight lang="sequencel">import <Utilities/Conversion.sl>;
import <Utilities/Sequence.sl>;
import <RegEx/RegEx.sl>;
Line 5,884 ⟶ 10,042:
letter when ascii >= 65 and ascii <= 90
else
intToAscii(ascii - 32);</langsyntaxhighlight>
 
=={{header|Sidef}}==
{{trans|Perl}}
<langsyntaxhighlight lang="ruby">func can_make_word(word, blocks) {
 
blocks.map! { |b| b.uc.chars.sort.join }.freq!
Line 5,904 ⟶ 10,062:
return false;
}(word.uc.chars, blocks)
}</langsyntaxhighlight>
 
Tests:
<langsyntaxhighlight lang="ruby">var b1 = %w(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM)
var b2 = %w(US TZ AO QA)
 
Line 5,925 ⟶ 10,083:
say ("%7s -> %s" % (t[0], bool));
assert(bool == t[1])
}</langsyntaxhighlight>
 
{{out}}
Line 5,937 ⟶ 10,095:
CONFUSE -> true
auto -> true
</pre>
 
=={{header|Simula}}==
<syntaxhighlight lang="simula">COMMENT ABC PROBLEM;
BEGIN
 
CLASS BLOCK(CH1, CH2); CHARACTER CH1, CH2;
BEGIN
BOOLEAN USED;
END;
 
CLASS GAME(WORD, POSSIBLE); TEXT WORD; BOOLEAN POSSIBLE;;
 
BOOLEAN PROCEDURE CANMAKEWORD(WORD); TEXT WORD;
BEGIN
INTEGER I, NUMBLOCKS;
BOOLEAN ALLPOSSIBLE, FOUND;
NUMBLOCKS := UPPERBOUND(BLOCKS, 1);
FOR I := 1 STEP 1 UNTIL NUMBLOCKS DO
BLOCKS(I).USED := FALSE;
ALLPOSSIBLE := TRUE;
 
WORD.SETPOS(1);
WHILE ALLPOSSIBLE AND WORD.MORE DO
BEGIN
CHARACTER WORDCHAR;
WORDCHAR := WORD.GETCHAR;
FOUND := FALSE;
FOR I := 1 STEP 1 UNTIL NUMBLOCKS DO
BEGIN
INSPECT BLOCKS(I) DO
BEGIN
IF (WORDCHAR = CH1 OR WORDCHAR = CH2) AND NOT USED THEN
BEGIN
USED := FOUND := TRUE;
GOTO L;
END;
END;
END;
L:
IF NOT FOUND THEN
ALLPOSSIBLE := FALSE;
END;
CANMAKEWORD := ALLPOSSIBLE;
END CANMAKEWORD;
 
REF(BLOCK) ARRAY BLOCKS(1:20);
REF(GAME) ARRAY GAMES(1:7);
TEXT WORD;
BEGIN
INTEGER I;
I := I+1; BLOCKS(I) :- NEW BLOCK('B', 'O');
I := I+1; BLOCKS(I) :- NEW BLOCK('X', 'K');
I := I+1; BLOCKS(I) :- NEW BLOCK('D', 'Q');
I := I+1; BLOCKS(I) :- NEW BLOCK('C', 'P');
I := I+1; BLOCKS(I) :- NEW BLOCK('N', 'A');
I := I+1; BLOCKS(I) :- NEW BLOCK('G', 'T');
I := I+1; BLOCKS(I) :- NEW BLOCK('R', 'E');
I := I+1; BLOCKS(I) :- NEW BLOCK('T', 'G');
I := I+1; BLOCKS(I) :- NEW BLOCK('Q', 'D');
I := I+1; BLOCKS(I) :- NEW BLOCK('F', 'S');
I := I+1; BLOCKS(I) :- NEW BLOCK('J', 'W');
I := I+1; BLOCKS(I) :- NEW BLOCK('H', 'U');
I := I+1; BLOCKS(I) :- NEW BLOCK('V', 'I');
I := I+1; BLOCKS(I) :- NEW BLOCK('A', 'N');
I := I+1; BLOCKS(I) :- NEW BLOCK('O', 'B');
I := I+1; BLOCKS(I) :- NEW BLOCK('E', 'R');
I := I+1; BLOCKS(I) :- NEW BLOCK('F', 'S');
I := I+1; BLOCKS(I) :- NEW BLOCK('L', 'Y');
I := I+1; BLOCKS(I) :- NEW BLOCK('P', 'C');
I := I+1; BLOCKS(I) :- NEW BLOCK('Z', 'M');
END;
BEGIN
INTEGER N, I; BOOLEAN ANSWER;
N := N+1; GAMES(N) :- NEW GAME("A", TRUE);
N := N+1; GAMES(N) :- NEW GAME("BARK", TRUE);
N := N+1; GAMES(N) :- NEW GAME("BOOK", FALSE);
N := N+1; GAMES(N) :- NEW GAME("TREAT", TRUE);
N := N+1; GAMES(N) :- NEW GAME("COMMON", FALSE);
N := N+1; GAMES(N) :- NEW GAME("SQUAD", TRUE);
N := N+1; GAMES(N) :- NEW GAME("CONFUSE", TRUE);
FOR I := 1 STEP 1 UNTIL N DO
BEGIN
INSPECT GAMES(I) DO
BEGIN
OUTTEXT(WORD);
OUTTEXT(" => ");
ANSWER := CANMAKEWORD(WORD);
OUTCHAR(IF ANSWER THEN 'T' ELSE 'F');
IF ANSWER EQV POSSIBLE
THEN OUTTEXT(" OK")
ELSE OUTTEXT(" ------------- WRONG!");
OUTIMAGE;
END;
END;
END;
 
 
END.
</syntaxhighlight>
{{out}}
<pre>A => T OK
BARK => T OK
BOOK => F OK
TREAT => T OK
COMMON => F OK
SQUAD => T OK
CONFUSE => T OK
</pre>
 
=={{header|Smalltalk}}==
Recursive solution. Tested in Pharo.
<langsyntaxhighlight lang="smalltalk">
ABCPuzzle>>test
#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
Line 5,963 ⟶ 10,229:
(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
^ false
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 5,975 ⟶ 10,241:
sQUAD: true
CONFuSE: true
</pre>
 
=={{header|SNOBOL4}}==
{{works with|SNOBOL4, SPITBOL for Linux}}
<syntaxhighlight lang="snobol4">
* Program: abc.sbl,
* To run: sbl -r abc.sbl
* Comment: Tested using the Spitbol for Linux version of SNOBOL4
 
* Read in blocks to construct the blocks string
in1
line = replace(input,&lcase,&ucase) :f(in1end)
line ? breakx(' ') . pre ' ' rem . post :f(in1end)
blocks = blocks "," pre post
:(in1)
in1end
 
* Function to determine if a word can be constructed with the given blocks
define('abc(blocks,word)s,i,let')
abcpat = (breakx(',') ',') . pre (*let len(1) | len(1) *let) rem . post
:(abc_end)
abc
eq(size(word),0) :s(abc3)
s = replace(word,&lcase,&ucase)
i = 0
abc2
i = lt(i,size(s)) i + 1 :f(abc4)
let = substr(s,i,1)
blocks ? abcpat = pre post :f(abc3)
:(abc2)
abc3
abc = 'False' :(abc5)
abc4
abc = 'True' :(abc5)
abc5
output = lpad('can_make_word("' word '"): ',26) abc
abc = ""
:(return)
abc_end
 
* Check words
* output = abc(blocks,"")
* output = abc(blocks," ")
output = abc(blocks,'A')
output = abc(blocks,'bark')
output = abc(blocks,'BOOK')
output = abc(blocks,'TrEAT')
output = abc(blocks,'COMMON')
output = abc(blocks,'SQUAD')
output = abc(blocks,'CONFUSE')
* The blocks are entered below, after the following END label
END
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
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
 
=={{header|SPAD}}==
{{works with|FriCAS, OpenAxiom, Axiom}}
<syntaxhighlight lang="spad">
<lang SPAD>
blocks:List Tuple Symbol:= _
[(B,O),(X,K),(D,Q),(C,P),(N,A),(G,T),(R,E),(T,G),(Q,D),(F,S), _
Line 6,004 ⟶ 10,359:
[canMakeWord?(s,blocks) for s in Example]
 
</syntaxhighlight>
</lang>
 
Programming details:[http://fricas.github.io/book.pdf UserGuide]
Line 6,017 ⟶ 10,372:
There is optimization potential of course.
 
=={{header|Standard ML}}==
<syntaxhighlight lang="ocaml">
val 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")];
val words = ["A","BARK","BOOK","TREaT","COMMON","SQUAD","CONFUSE"];
open List;
 
local
val remove = fn x => fn B => (fn (a,b) => (tl a)@b ) (partition ( fn a=> x=a) B)
in
fun cando ([] , Done, B ) = true
| cando (h::t, Done, []) = false
| cando (h::t, Done, B ) =
let
val S = find (fn (a,b) => a=h orelse b=h) B
in
if isSome S then cando (t, (h,valOf S)::Done, remove (valOf S) B)
else
let
val T = find ( fn(_,(a,b)) => a=h orelse b=h) Done
val U = if isSome T then find (fn (a,b) => a = #1 (valOf T) orelse b = #1 (valOf T) ) B else NONE
in
if isSome T andalso isSome U
then cando ( t, (#1 (valOf T),(valOf U))::(h,#2 (valOf T))::(remove (valOf T) Done), remove (valOf U) B)
else false
end
end
end;
 
map (fn st => cando(map Char.toUpper (String.explode st),[],BLOCKS)) words;
 
val BLOCKS = [(#"U",#"S"), (#"T",#"Z"), (#"A",#"O"), (#"Q",#"A")];
val words = ["A","UTAH","AutO"];
map (fn st => cando(map Char.toUpper (String.explode st),[],BLOCKS)) words;
</syntaxhighlight>
Output
<pre>val it = [true, true, false, true, false, true, true]: bool list
val it = [true, false, true]: bool list
</pre>
 
=={{header|Swift}}==
<langsyntaxhighlight Swiftlang="swift">import Foundation
 
func Blockable(str: String) -> Bool {
Line 6,051 ⟶ 10,446:
for str in [ "A", "BARK", "BooK", "TrEaT", "comMON", "sQuAd", "Confuse" ] {
println("'\(str)' \(CanOrNot(Blockable(str))) be spelled with blocks.")
}</langsyntaxhighlight>
{{out}}
<pre>
Line 6,064 ⟶ 10,459:
 
{{works with|Swift|3.0.2}}
<langsyntaxhighlight Swiftlang="swift">import Swift
 
func canMake(word: String) -> Bool {
Line 6,085 ⟶ 10,480:
let words = ["a", "bARK", "boOK", "TreAt", "CoMmon", "SquAd", "CONFUse"]
 
words.forEach { print($0, canMake(word: $0)) }</langsyntaxhighlight>
{{out}}
<pre>
Line 6,099 ⟶ 10,494:
=={{header|Tcl}}==
{{works with|Tcl|8.6}}
<langsyntaxhighlight 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}}} {
Line 6,119 ⟶ 10,514:
foreach word {"" A BARK BOOK TREAT COMMON SQUAD CONFUSE} {
puts [format "Can we spell %9s? %s" '$word' [abc $word]]
}</langsyntaxhighlight>
{{out}}
<pre>
Line 6,130 ⟶ 10,525:
Can we spell 'SQUAD'? true
Can we spell 'CONFUSE'? true
</pre>
 
=={{header|Transd}}==
The code properly handles the backtracking issue (see the note in the Fortran solution).
 
<syntaxhighlight lang="Scheme">#lang transd
 
MainModule: {
blocks: ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"],
words: ["A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"],
 
testMake: Lambda<String Vector<String> Bool>(λ
w String() v Vector<String>()
locals: c (toupper (subn w 0))
(for bl in v do
(if (contains bl c)
(if (== (size w) 1) (ret true))
(if (exec testMake (sub w 1) (erase (cp v) @idx))
(ret true)))
)
(ret false)
),
_start: (lambda
(for word in words do
(lout :boolalpha word " : "
(exec testMake word blocks))
)
)
}</syntaxhighlight>
{{out}}
<pre>
A : true
BARK : true
BOOK : false
TREAT : true
COMMON : false
SQUAD : true
CONFUSE : true
</pre>
 
=={{header|TUSCRIPT}}==
<langsyntaxhighlight lang="tuscript">set words = "A'BARK'BOOK'TREAT'COMMON'SQUAD'CONFUSE"
set result = *
loop word = words
Line 6,150 ⟶ 10,584:
set out = concat (word, " ", cond)
set result = append (result, out)
endloop</langsyntaxhighlight>
{{out}}
<pre>A true
Line 6,162 ⟶ 10,596:
=={{header|TXR}}==
 
<langsyntaxhighlight lang="txr">@(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)
Line 6,208 ⟶ 10,642:
@(if (can-make-word w) "True" "False")
@(end)
@(end)</langsyntaxhighlight>
 
Run:
Line 6,235 ⟶ 10,669:
>>> can_make_word("CONFUSE")
True</pre>
 
 
 
=={{header|uBasic/4tH}}==
{{trans|FreeBASIC}}
<syntaxhighlight lang="uBasic/4tH">Dim @b(40) ' holds the blocks
Dim @d(20)
' load blocks from string in lower case
a := "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
For x = 0 To Len (a)-1 : @b(x) = Or(Peek(a, x), Ord(" ")) : Next
' push words onto stack
Push "A", "Bark", "Book", "Treat", "Common", "Squad", "Confuse"
 
Do While Used() ' as long as words on the stack
w = Pop() ' get a word
p = 1 ' assume it's possible
For x = 0 To 19 : @d(x) = 0 : Next ' zero the @d-array
 
For i = 0 To Len(w) - 1 ' test the entire word
c = Or(Peek(w, i), Ord(" ")) ' get a lower case char
For x = 0 To 19 ' now test all the blocks
If @d(x) = 0 Then If (@b(x*2)=c) + (@b(x*2+1)=c) Then @d(x) = 1 : Break
Next
If x = 20 Then p = 0 : Break ' we've tried all the blocks - no fit
Next
' show the result
Print Show(w), Show(Iif(p, "True", "False"))
Loop</syntaxhighlight>
{{Out}}
<pre>Confuse True
Squad True
Common False
Treat True
Book False
Bark True
A True
 
0 OK, 0:1144</pre>
 
=={{header|Ultimate++}}==
This is example is a slight modification of the C and C++ examples. To avoid warning "<bold>warning: ISO C++11 does not allow conversion from string literal to 'char *' [-Wwritable-strings]</bold> the strings added to char were individually prefixed with (char*). Swap is used instead of SWAP. Return 0 was not not needed.
 
<syntaxhighlight lang="cpp">
#include <Core/Core.h>
#include <stdio.h>
#include <ctype.h>
//C++
#include <iostream>
#include <vector>
#include <string>
#include <set>
#include <cctype>
 
 
//C++
typedef std::pair<char,char> item_t;
typedef std::vector<item_t> list_t;
 
 
//C
using namespace Upp;
 
int can_make_words(char **b, char *word)
{
int i, ret = 0, c = toupper(*word);
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]); // It needs to be Swap and not SWAP
ret = can_make_words(b + 1, word + 1);
Swap(b[i], b[0]); // It needs to be Swap instead of SWAP
}
return ret;
}
 
 
//C++
 
bool can_create_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();
}
 
 
// U++
CONSOLE_APP_MAIN
{
// C
char* blocks[] =
{
(char*)"BO", (char*)"XK", (char*)"DQ", (char*)"CP",
(char*)"NA", (char*)"GT", (char*)"RE", (char*)"TG",
(char*)"QD", (char*)"FS", (char*)"JW", (char*)"HU",
(char*)"VI", (char*)"AN", (char*)"OB", (char*)"ER",
(char*)"FS", (char*)"LY", (char*)"PC", (char*)"ZM", 0
};
char *words[] =
{
(char*)"", (char*)"A", (char*)"BARK", (char*)"BOOK",
(char*)"TREAT", (char*)"COMMON", (char*)"SQUAD", (char*)"Confuse", 0
};
char **w;
for (w = words; *w; w++)
printf("%s\t%d\n", *w, can_make_words(blocks, *w));
printf("\n");
// C++
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> wordsb{"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
for (const std::string& w : wordsb) {
std::cout << w << ": " << std::boolalpha << can_create_word(w, vals) << ".\n";
}
std::cout << "\n";
 
const Vector<String>& cmdline = CommandLine();
for(int i = 0; i < cmdline.GetCount(); i++) {
}
 
}
</syntaxhighlight>
 
{{out}}
<pre>
1
A 1
BARK 1
BOOK 0
TREAT 1
COMMON 0
SQUAD 1
Confuse 1
 
A: true.
BARK: true.
BOOK: false.
TREAT: true.
COMMON: false.
SQUAD: true.
Confuse: true.
 
<--- Finished in (0:00.53), exitcode: 0 --->
</pre>
 
=={{header|UNIX Shell}}==
{{works with|bash}}
 
<langsyntaxhighlight lang="bash">can_build_word() {
if [[ $1 ]]; then
can_build_word_rec "$1" BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
Line 6,277 ⟶ 10,879:
can_build_word "$word" "${blocks[@]}" && ans=yes || ans=no
printf "%s\t%s\n" "$word" $ans
done</langsyntaxhighlight>
 
{{out}}
Line 6,288 ⟶ 10,890:
Squad yes
confuse yes</pre>
 
=={{header|UTFool}}==
 
'''String-based solution'''
 
<syntaxhighlight lang="utfool">
···
http://rosettacode.org/wiki/ABC_Problem
···
■ ABC
§ static
blocks⦂ StringBuffer " BO XK DQ CP NA GT RE TG QD FS
JW HU VI AN OB ER FS LY PC ZM"
▶ main
• args⦂ String[]
for each word in ["A", "BARK", "BOOK", "TREAT",
"COMMON", "SQUAD", "CONFUSE"]⦂ String
System.out.println "⸨word⸩: ⸨canMakeWord word⸩"
 
▶ canMakeWord⦂ boolean
• word⦂ String
solution⦂ boolean: word.isEmpty°
if no solution
i⦂ int: blocks.indexOf word.substring 0, 1
🔁 until solution or i < 0
i: i ÷ 3 × 3 · block index
block⦂ String: blocks.substring i, i + 3
blocks.delete i, i + 3 · remove block
solution: canMakeWord word.substring 1
blocks.insert i, block · restore block
i: blocks.indexOf (word.substring 0, 1), i + 3
return solution
</syntaxhighlight>
 
'''Collection-based solution'''
 
<syntaxhighlight lang="utfool">
···
http://rosettacode.org/wiki/ABC_Problem
···
import java.util.Arrays
import java.util.Collections
import java.util.List
■ ABC
§ static
▶ main
• args⦂ String[]
blocks⦂ List⟨String⟩:
Arrays.asList "BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB",
"ER", "FS", "LY", "PC", "ZM"
words⦂ List⟨String⟩:
Arrays.asList "A", "BARK", "BOOK", "TREAT",
"COMMON", "SQUAD", "CONFUSE"
for each word in words
System.out.println "⸨word⸩: ⸨canMakeWord word, blocks⸩"
 
▶ canMakeWord⦂ boolean
• word⦂ String
• blocks⦂ List⟨String⟩
if word.isEmpty°
return true
for each block #i in blocks⦂ String
if 0 ≤ block.indexOf word.charAt 0
Collections.swap blocks, 0, i
if canMakeWord (word.substring 1),
blocks.subList 1, blocks.size°
return true
Collections.swap blocks, 0, i
return false
</syntaxhighlight>
 
=={{header|VBA}}==
 
<syntaxhighlight lang="vb">
Option Explicit
 
Sub Main_ABC()
Dim Arr, i As Long
 
Arr = Array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE")
For i = 0 To 6
Debug.Print ">>> can_make_word " & Arr(i) & " => " & ABC(CStr(Arr(i)))
Next i
End Sub
 
Function ABC(myWord As String) As Boolean
Dim myColl As New Collection
Dim NbLoop As Long, NbInit As Long
Dim b As Byte, i As Byte
Const BLOCKS As String = "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"
 
For b = 0 To 19
myColl.Add Split(BLOCKS, ";")(b), Split(BLOCKS, ";")(b) & b
Next b
NbInit = myColl.Count
NbLoop = NbInit
For b = 1 To Len(myWord)
For i = 1 To NbLoop
If i > NbLoop Then Exit For
If InStr(myColl(i), Mid(myWord, b, 1)) <> 0 Then
myColl.Remove (i)
NbLoop = NbLoop - 1
Exit For
End If
Next
Next b
ABC = (NbInit = (myColl.Count + Len(myWord)))
End Function
</syntaxhighlight>
{{out}}
<pre>
>>> 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</pre>
 
=={{header|V (Vlang)}}==
<syntaxhighlight lang="v (vlang)">
const
(
blocks = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
words = ["A", BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
)
 
fn main() {
for word in words {
println('>>> can_make_word("${word.to_upper()}"): ')
if check_word(word, blocks) == true {println('True')} else {println('False')}
}
}
 
fn check_word(word string, blocks []string) bool {
mut tblocks := blocks.clone()
mut found := false
for chr in word {
found = false
for idx, _ in tblocks {
if tblocks[idx].contains(chr.ascii_str()) == true {
tblocks[idx] =''
found = true
break
}
}
if found == false {return found}
}
return found
}
</syntaxhighlight>
 
{{out}}
<pre>
>>> 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
</pre>
 
=={{header|Wren}}==
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
 
var r // recursive
r = Fn.new { |word, bl|
if (word == "") return true
var c = word.bytes[0] | 32
for (i in 0...bl.count) {
var b = bl[i]
if (c == b.bytes[0] | 32 || c == b.bytes[1] | 32) {
bl[i] = bl[0]
bl[0] = b
if (r.call(word[1..-1], bl[1..-1])) return true
var t = bl[i]
bl[i] = bl[0]
bl[0] = t
}
}
return false
}
 
var newSpeller = Fn.new { |blocks|
var bl = blocks.split(" ")
return Fn.new { |word| r.call(word, bl) }
}
 
var sp = newSpeller.call("BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM")
for (word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"]) {
Fmt.print("$-7s $s", word, sp.call(word))
}</syntaxhighlight>
 
{{out}}
<pre>
A true
BARK true
BOOK false
TREAT true
COMMON false
SQUAD true
CONFUSE true
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">string 0;
 
char Side1, Side2;
def Size = 20;
char Avail(Size);
 
func CanMakeWord(Word); \returns 'true' if blocks can make Word
char Word;
int I, Let;
[Let:= Word(0) & $5F; \get letter and make sure it's uppercase
if Let = 0 then return true; \if 0 then end of word; return successful
for I:= 0 to Size-1 do \scan for block that contains letter
if Avail(I) and (Side1(I) = Let or Side2(I) = Let) then
[Avail(I):= false;
if CanMakeWord(Word+1) then return true;
];
return false;
];
 
int I, J, Words;
[Side1:= "BXDCNGRTQFJHVAOEFLPZ";
Side2:= "OKQPATEGDSWUINBRSYCM";
Words:= ["A", "bark", "Book", "Treat", "Common", "Squad", "conFuse"];
for J:= 0 to 6 do
[Text(0, "Can make ^""); Text(0, Words(J)); Text(0, "^": ");
for I:= 0 to Size-1 do Avail(I):= true;
Text(0, if CanMakeWord(Words(J)) then "True" else "False"); CrLf(0);
];
]</syntaxhighlight>
 
{{out}}
<pre>
Can make "A": True
Can make "bark": True
Can make "Book": False
Can make "Treat": True
Can make "Common": False
Can make "Squad": True
Can make "conFuse": True
</pre>
 
=={{header|Yabasic}}==
<syntaxhighlight lang="yabasic">letters$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
 
sub canMake(letters$, word$)
local i, j, p, n, pairs$(1)
n = token(letters$, pairs$(), ",")
word$ = upper$(word$)
for i = 1 to len(word$)
for j = 1 to n
p = instr(pairs$(j), mid$(word$, i, 1))
if p then
pairs$(j) = ""
break
end if
next j
if not p return false
next i
return true
end sub
 
print "a = ", canMake(letters$, "a") // 1 = true
print "bark = ", canMake(letters$, "Bark") // 1
print "book = ", canMake(letters$, "BooK") // 0 = false
print "treat = ", canMake(letters$, "TREAt") // 1
print "common = ", canMake(letters$, "common") // 0
print "squad = ", canMake(letters$, "squad") // 1
print "confuse = ", canMake(letters$, "confuse") // 1</syntaxhighlight>
 
=={{header|zkl}}==
{{trans|C}}
<langsyntaxhighlight lang="zkl">var blocks=T("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM", );
 
Line 6,309 ⟶ 11,199:
foreach word in (T("","A","BarK","BOOK","TREAT","COMMON","SQUAD","Confuse","abba")){
can_make_word(word).println(": ",word);
}</langsyntaxhighlight>
{{out}}
<pre>
Line 6,321 ⟶ 11,211:
True: Confuse
True: abba
</pre>
 
=={{header|zonnon}}==
<syntaxhighlight lang="zonnon">
module Main;
type
Block = record
l,r: char;
used: boolean;
end Block;
 
var
blocks: array 20 of Block;
 
procedure Exists(c: char): boolean;
var
i: integer;
r: boolean;
begin
r := false;i := 0;
while ~r & (i < len(blocks)) do
if ~(blocks[i].used) then
r := (blocks[i].l = cap(c)) or (blocks[i].r = cap(c));
blocks[i].used := r;
end;
inc(i)
end;
return r
end Exists;
 
procedure CanMakeWord(s: string);
var
i: integer;
made: boolean;
begin
made := true;
for i := 0 to len(s) - 1 do
made := made & Exists(s[i])
end;
writeln(s:20,"?",made);
Clean()
end CanMakeWord;
 
procedure Clean();
var
i: integer;
begin
for i := 0 to len(blocks) - 1 do
blocks[i].used := false
end
end Clean;
 
procedure InitBlock(i:integer;l,r:char);
begin
blocks[i].l := l;blocks[i].r := r;
blocks[i].used := false;
end InitBlock;
 
procedure Init;
begin
InitBlock(0,'B','O');
InitBlock(1,'X','K');
InitBlock(2,'D','Q');
InitBlock(3,'C','Q');
InitBlock(4,'N','A');
InitBlock(5,'G','T');
InitBlock(6,'R','E');
InitBlock(7,'T','G');
InitBlock(8,'Q','D');
InitBlock(9,'F','S');
InitBlock(10,'J','W');
InitBlock(11,'H','U');
InitBlock(12,'V','I');
InitBlock(13,'A','N');
InitBlock(14,'O','B');
InitBlock(15,'E','R');
InitBlock(16,'F','S');
InitBlock(17,'L','Y');
InitBlock(18,'P','C');
InitBlock(19,'Z','M')
end Init;
 
begin
Init();
CanMakeWord("A");
CanMakeWord("BARK");
CanMakeWord("BOOK");
CanMakeWord("TREAT");
CanMakeWord("COMMON");
CanMakeWord("confuse");
end Main.
</syntaxhighlight>
{{Out}}
<pre>
A ? true
BARK ? true
BOOK ? false
TREAT ? true
COMMON ? false
confuse ? true
</pre>
 
=={{header|ZX Spectrum Basic}}==
<langsyntaxhighlight lang="zxbasic">10 LET b$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
20 READ p
30 FOR c=1 TO p
Line 6,344 ⟶ 11,334:
190 REM Erase pair
200 IF j/2=INT (j/2) THEN LET u$(j-1 TO j)=" ": RETURN
210 LET u$(j TO j+1)=" ": RETURN</langsyntaxhighlight>
{{out}}
<pre>
2,114

edits