ABC problem: Difference between revisions
Add ABC
Drkameleon (talk | contribs) |
Not a robot (talk | contribs) (Add ABC) |
||
(47 intermediate revisions by 25 users not shown) | |||
Line 44:
;Example:
<
True
>>> can_make_word("BARK")
Line 57:
True
>>> can_make_word("CONFUSE")
True</
{{Template:Strings}}
Line 64:
=={{header|11l}}==
{{trans|Python}}
<
I word == ‘’
R 0B
Line 79:
R 1B
print([‘’, ‘a’, ‘baRk’, ‘booK’, ‘treat’, ‘COMMON’, ‘squad’, ‘Confused’].map(w -> ‘'’w‘': ’can_make_word(w)).join(‘, ’))</
=={{header|360 Assembly}}==
The program uses one ASSIST macro (XPRNT) to keep the code as short as possible.
<
ABC CSECT
USING ABC,R13 base register
Line 158:
YREGS
NN EQU (BLOCKS-WORDS)/L'WORDS number of words
END ABC</
{{out}}
<pre>
Line 171:
=={{header|8080 Assembly}}==
<
jmp test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Line 247:
wrdcommon: db 'COMMON$'
wrdsquad: db 'SQUAD$'
wrdconfuse: db 'CONFUSE$'</
{{out}}
Line 263:
{{trans|8080 Assembly}}
<
bits 16
org 100h
Line 325:
.cmn: db 'COMMON$'
.squad: db 'SQUAD$'
.confs: db 'CONFUSE$'</
{{out}}
Line 338:
=={{header|8th}}==
<
\ ========================================================================================
\ You are given a collection of ABC blocks
Line 537:
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 */
Line 728:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
{{Output}}
<pre>
Line 747:
</pre>
=={{header|ABAP}}==
<syntaxhighlight lang="abap">
REPORT z_rosetta_abc.
Line 820:
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>
Line 831:
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!}}==
<
CHAR ARRAY sideA="BXDCNGRTQFJHVAOEFLPZ"
CHAR ARRAY sideB="OKQPATEGDSWUINBRSYCM"
Line 889 ⟶ 916:
Test("SQuaD")
Test("CoNfUsE")
RETURN</
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/ABC_problem.png Screenshot from Atari 8-bit computer]
Line 906 ⟶ 933:
Using #HASH-OFF
</pre>
<
FUNCTION bCAN_MAKE_WORD(zWord: STRING): BOOLEAN
VAR sBlockCount: SHORT
Line 933 ⟶ 960:
RETURN OCCURS(zUsedBlocks, ",") = sWordLength
ENDFUNCTION
</syntaxhighlight>
{{out}}
<pre>
Line 950 ⟶ 977:
</pre>
<
use Ada.Characters.Handling;
Line 1,028 ⟶ 1,055:
end loop;
end Abc_Problem;
</syntaxhighlight>
{{out}}
Line 1,043 ⟶ 1,070:
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.win32}}
<
# construct the list of blocks #
Line 1,123 ⟶ 1,150:
)
</syntaxhighlight>
Output:
<pre>
Line 1,136 ⟶ 1,163:
=={{header|ALGOL W}}==
<
begin
% Returns true if we can spell the word using the blocks, %
Line 1,216 ⟶ 1,243:
testCanSpell( "confuse", 7 )
end
end.</
{{out}}
<pre>
Line 1,229 ⟶ 1,256:
=={{header|Apex}}==
<
if (String.isEmpty(word)) {
return true;
Line 1,273 ⟶ 1,300:
System.debug('"COMMON": ' + canMakeWord(blocks, 'COMMON'));
System.debug('"SQuAd": ' + canMakeWord(blocks, 'SQuAd'));
System.debug('"CONFUSE": ' + canMakeWord(blocks, 'CONFUSE'));</
{{out}}
<pre>"": true
Line 1,286 ⟶ 1,313:
=={{header|APL}}==
{{works with|Dyalog APL|16.0}}
<
{{out}}
<pre> )COPY dfns ucase
Line 1,296 ⟶ 1,323:
=={{header|AppleScript}}==
===Imperative===
<
"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}
Line 1,323 ⟶ 1,350:
end repeat
return false
end canMakeWordWithBlocks</
----
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
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===
<
use framework "Foundation"
Line 1,522 ⟶ 1,607:
set my text item delimiters to dlm
s
end unlines</
{{Out}}
<pre> '' -> true
Line 1,534 ⟶ 1,619:
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program problemABC.s */
Line 1,718 ⟶ 1,803:
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
Can_make_word: A
Line 1,737 ⟶ 1,822:
=={{header|Arturo}}==
<
[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 1,762 ⟶ 1,847:
loop ["A" "BaRk" "bOoK" "tReAt" "CoMmOn" "SqUaD" "cONfUsE"] 'wrd
-> print [wrd "=>" canMakeWord? wrd]</
{{Out}}
<pre>A => true
Line 1,773 ⟶ 1,858:
=={{header|Astro}}==
<
if ls.isempty:
return true
Line 1,784 ⟶ 1,869:
for s in test:
print "($|>8|{s} ${abc(s, list)})"</
=={{header|AutoHotkey}}==
'''Function'''
<
o := {}
loop, parse, blocks, `n, `r
Line 1,812 ⟶ 1,897:
added := 1
}
}</
'''Test Input''' (as per question)
<
(
BO
Line 1,852 ⟶ 1,937:
loop, parse, wordlist, `n
out .= A_LoopField " - " isWordPossible(blocks, A_LoopField) "`n"
msgbox % out</
{{out}}
Line 2,012 ⟶ 2,097:
=={{header|BaCon}}==
<
DATA "A", "BARK", "BOOK", "TREAT", "Common", "Squad", "Confuse"
Line 2,035 ⟶ 2,120:
PRINT word$, IIF$(LEN(word$) = count-AMOUNT(block$), "True", "False") FORMAT "%-10s: %s\n"
WEND</
{{out}}
<pre>
Line 2,049 ⟶ 2,134:
=={{header|BASIC}}==
Works with:VB-DOS, QB64, QBasic, QuickBASIC
<
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' ABC_Problem '
Line 2,175 ⟶ 2,260:
END FUNCTION
</syntaxhighlight>
==={{header|Commodore BASIC}}===
{{trans|Sinclair ZX-81 BASIC}}
<
20 W$ = "BARK" : GOSUB 100
30 W$ = "BOOK" : GOSUB 100
Line 2,203 ⟶ 2,288:
230 RETURN
240 PRINT W$" -> NO"
250 RETURN</
{{out}}
Line 2,216 ⟶ 2,301:
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:
<
110 MS=100:REM MAX STACK DEPTH
120 DIM BL$(MS):REM BLOCKS LEFT
Line 2,255 ⟶ 2,340:
470 DATA A, BORK, BOOK, TREAT, COMMON, SQUAD, CONFUSE, ""
480 DATA ABABACAC,ABBA,""
490 DATA ""</
{{Out}}
Line 2,277 ⟶ 2,362:
==={{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.
<
20 INPUT W$
30 FOR I=1 TO LEN W$
Line 2,287 ⟶ 2,372:
90 STOP
100 NEXT J
110 PRINT "NO"</
{{in}}
<pre>A</pre>
Line 2,316 ⟶ 2,401:
{{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}}==
<
@echo off
::abc.bat
Line 2,381 ⟶ 2,517:
:END
</syntaxhighlight>
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<
PROCcan_make_word("A")
PROCcan_make_word("BARK")
Line 2,406 ⟶ 2,542:
ENDWHILE
IF word$>"" PRINT "False" ELSE PRINT "True"
ENDPROC</
{{out}}
Line 2,419 ⟶ 2,555:
=={{header|BCPL}}==
<
let canMakeWord(word) = valof
Line 2,455 ⟶ 2,591:
show("SQUAD")
show("CONFUSE")
$)</
{{out}}
<pre>A: yes
Line 2,466 ⟶ 2,602:
=={{header|BQN}}==
<
Matches ← ⊑⊸(⊑∘∊¨)˜ /⊣ # blocks matching current letter
Others ← <˘∘⍉∘(»⊸≥∨`)∘(≡⌜)/¨<∘⊣ # blocks without current matches
Line 2,481 ⟶ 2,617:
words←⟨"A","bark","BOOK","TrEaT","Common","Squad","Confuse"⟩
> {(<𝕩) ∾ blocks ABC 𝕩}¨ words</
{{out}}
<pre>┌─
Line 2,494 ⟶ 2,630:
=={{header|Bracmat}}==
<
( can-make-word
= ABC blocks
Line 2,541 ⟶ 2,677:
& can-make-word'SQUAD
& can-make-word'CONFUSE
);</
{{out}}
<pre>A yes
Line 2,553 ⟶ 2,689:
=={{header|C}}==
Recursive solution. Empty string returns true.
<
#include <ctype.h>
Line 2,593 ⟶ 2,729:
return 0;
}</
{{out}}
<pre>
Line 2,610 ⟶ 2,746:
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).
<
using System.IO;
// Needed for the method.
Line 2,640 ⟶ 2,776:
return true;
}
</syntaxhighlight>
{{out}}
<pre>
Line 2,652 ⟶ 2,788:
</pre>
'''Unoptimized'''
<
using System.Linq;
Line 2,734 ⟶ 2,870:
}
}
</syntaxhighlight>
{{out}}
<pre>
Line 2,748 ⟶ 2,884:
{{Works with|C++11}}
Build with:
<
<
#include <vector>
#include <string>
Line 2,782 ⟶ 2,918:
std::cout << w << ": " << std::boolalpha << can_make_word(w,vals) << ".\n";
}
}</
{{out}}
Line 2,799 ⟶ 2,935:
<b>module.ceylon</b>
<
module rosetta.abc "1.0.0" {}
</syntaxhighlight>
<b>run.ceylon</b>
<
shared void run() {
printAndCanMakeWord("A", blocks);
Line 2,880 ⟶ 3,016:
myRemainingLetterIndexes)
else false;
</syntaxhighlight>
{{out}}
Line 2,895 ⟶ 3,031:
=={{header|Clojure}}==
A translation of the Haskell solution.
<
(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 2,916 ⟶ 3,052:
(doseq [word ["A" "BARK" "Book" "treat" "COMMON" "SQUAD" "CONFUSE"]]
(->> word .toUpperCase (abc blocks) first (printf "%s: %b\n" word)))</
{{out}}
Line 2,928 ⟶ 3,064:
=={{header|CLU}}==
<
rslt: array[char] := array[char]$predict(1,string$size(s))
for c: char in string$chars(s) do
Line 2,971 ⟶ 3,107:
end
end
end start_up</
{{out}}
<pre>A: yes
Line 2,982 ⟶ 3,118:
=={{header|CoffeeScript}}==
<
canMakeWord = (word="") ->
Line 2,999 ⟶ 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)</
{{out}}
Line 3,012 ⟶ 3,148:
=={{header|Comal}}==
<
0020 blocks$:=" BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
0030 FOR i#:=1 TO LEN(word$) DO
Line 3,030 ⟶ 3,166:
0170 END
0180 //
0190 DATA "A","BARK","BOOK","treat","common","squad","CoNfUsE"</
{{out}}
<pre>A: yes
Line 3,041 ⟶ 3,177:
=={{header|Common Lisp}}==
<
(defun word-possible-p (word blocks)
(cond
Line 3,055 ⟶ 3,191:
collect (word-possible-p
(subseq word 1)
(remove b blocks))))))))</
{{out}}
Line 3,077 ⟶ 3,213:
=={{header|Component Pascal}}==
{{Works with|BlackBox Component Builder}}
<
MODULE ABCProblem;
IMPORT
Line 3,162 ⟶ 3,298:
END ABCProblem.
</syntaxhighlight>
Execute: ^Q ABCProblem.CanMakeWord A BARK BOOK TREAT COMMON SQUAD confuse~
{{out}}
Line 3,176 ⟶ 3,312:
=={{header|Cowgol}}==
<
include "strings.coh";
Line 3,219 ⟶ 3,355:
print(resp[can_make_word(words[i])]);
i := i + 1;
end loop;</
{{out}}
Line 3,235 ⟶ 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.
<
bool canMakeWord(in string word, in string[] blocks) pure /*nothrow*/ @safe {
Line 3,256 ⟶ 3,392:
foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
writefln(`"%s" %s`, word, canMakeWord(word, blocks));
}</
{{out}}
<pre>"" true
Line 3,269 ⟶ 3,405:
===@nogc Version===
The same as the precedent version, but it avoids all heap allocations and it's lower-level and ASCII-only.
<
bool canMakeWord(in string word, in string[] blocks) nothrow @nogc
Line 3,307 ⟶ 3,443:
foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
writefln(`"%s" %s`, word, canMakeWord(word, blocks));
}</
===Recursive Version===
This version is able to find the solution for the word "abba" given the blocks AB AB AC AC.
{{trans|C}}
<
alias Block = char[2];
Line 3,349 ⟶ 3,485:
immutable word = "abba";
writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
}</
{{out}}
<pre>"" true
Line 3,363 ⟶ 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.
<
alias Block = char[2];
Line 3,404 ⟶ 3,540:
immutable word = "abba";
writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
}</
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.
<
{$APPTYPE CONSOLE}
Line 3,472 ⟶ 3,608:
readln;
end.
</syntaxhighlight>
{{out}}
Line 3,486 ⟶ 3,622:
=={{header|Draco}}==
<
proc nonrec ucase(char c) char:
Line 3,538 ⟶ 3,674:
test("sQuAd");
test("CONFUSE")
corp</
{{out}}
<pre>A: yes
Line 3,552 ⟶ 3,688:
{{trans|Swift}}
<
var blocks = [
"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
Line 3,577 ⟶ 3,713:
for str in [ "A", "BARK", "BooK", "TrEaT", "comMON", "sQuAd", "Confuse" ] {
print("\"\(str)\" \(canOrNot(blockable(str))) be spelled with blocks.")
}</
{{out}}
Line 3,588 ⟶ 3,724:
"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}}==
<
(lib 'list) ;; list-delete
Line 3,607 ⟶ 3,781:
(spell (string-rest word) (list-delete blocks block))))))
</syntaxhighlight>
{{out}}
<pre>
Line 3,626 ⟶ 3,800:
=={{header|Ela}}==
{{trans|Haskell}}
<
:::IO
Line 3,642 ⟶ 3,816:
mapM_ (\w -> putLn (w, not << null $ abc blocks (map char.upper w)))
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]</
{{out}}
Line 3,655 ⟶ 3,829:
=={{header|Elena}}==
ELENA
<
import system'collections;
import system'culture;
import extensions;
import extensions'routines;
Line 3,667 ⟶ 3,842:
var list := ArrayList.load(blocks);
^ nil == (cast string(self)).
{
var index := list.indexOfElement
Line 3,696 ⟶ 3,871:
e.next();
words.forEach::(word)
{
console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
}
}</
{{out}}
<pre>
Line 3,716 ⟶ 3,891:
{{trans|Erlang}}
{{works with|Elixir|1.3}}
<
def can_make_word(word, avail) do
can_make_word(String.upcase(word) |> to_charlist, avail, [])
Line 3,731 ⟶ 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)</
{{out}}
Line 3,742 ⟶ 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}}==
<
-export([can_make_word/1, can_make_word/2, blocks/0]).
Line 3,761 ⟶ 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>
{{Out}}
Line 3,774 ⟶ 4,032:
=={{header|ERRE}}==
<syntaxhighlight lang="erre">
PROGRAM BLOCKS
Line 3,803 ⟶ 4,061:
CANMAKEWORD("Confuse")
END PROGRAM
</syntaxhighlight>
=={{header|Euphoria}}==
implemented using OpenEuphoria
<syntaxhighlight lang="euphoria">
include std/text.e
Line 3,843 ⟶ 4,101:
if getc(0) then end if
</syntaxhighlight>
{{out}}
<pre>
Line 3,859 ⟶ 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>
<
let rec look_for_right_candidate candidates noCandidates c rest =
match candidates with
Line 3,888 ⟶ 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</
{{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 3,904 ⟶ 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}}==
<
kernel math math.statistics qw sequences sets unicode ;
IN: rosetta-code.abc-problem
Line 3,950 ⟶ 4,252:
show-blocks header input [ result ] each ;
MAIN: abc-problem</
{{out}}
<pre>
Line 3,972 ⟶ 4,274:
=={{header|FBSL}}==
This approach uses a string, blanking out the pair previously found. Probably faster than array manipulation.
<
#APPTYPE CONSOLE
SUB MAIN()
Line 4,017 ⟶ 4,319:
RETURN TRUE
END FUNCTION
</syntaxhighlight>
{{out}}
<pre>
Line 4,037 ⟶ 4,339:
{{works with|gforth|0.7.3}}
<
variable blocks
: allotblocks ( -- ) here blockslist dup allot here over - swap move blocks ! ;
Line 4,066 ⟶ 4,368:
;
: .abc abc if ." True" else ." False" then ;</
{{out}}
Line 4,081 ⟶ 4,383:
=={{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!
<
!Compilation started at Thu Jun 5 01:52:03
!
Line 4,150 ⟶ 4,452:
end subroutine ucase
end program abc</
===But if backtracking might be needed===
Line 4,158 ⟶ 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">
MODULE PLAYPEN !Messes with a set of alphabet blocks.
INTEGER MSG !Output unit number.
Line 4,436 ⟶ 4,738:
END DO
END
</syntaxhighlight>
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 4,461 ⟶ 4,763:
=={{header|FreeBASIC}}==
<
' compile with: fbc -s console
Line 4,503 ⟶ 4,805:
Print : Print "hit any key to end program"
Sleep
End</
{{out}}
<pre>A true
Line 4,512 ⟶ 4,814:
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]'''
<
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"]
Line 4,542 ⟶ 4,925:
Next
End</
Output:
<pre>
Line 4,555 ⟶ 4,938:
=={{header|Go}}==
<
import (
Line 4,593 ⟶ 4,976:
fmt.Println(word, sp(word))
}
}</
{{out}}
<pre>
Line 4,607 ⟶ 4,990:
=={{header|Groovy}}==
Solution:
<
def blocks
Line 4,618 ⟶ 5,001:
word.every { letter -> blocksLeft.remove(blocksLeft.find { block -> block.contains(letter) }) }
}
}</
Test:
<
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"])
['', 'A', 'BARK', 'book', 'treat', 'COMMON', 'SQuAd', 'CONFUSE'].each {
println "'${it}': ${a.canMakeWord(it)}"
}</
{{out}}
Line 4,640 ⟶ 5,023:
=={{header|Harbour}}==
Harbour Project implements a cross-platform Clipper/xBase compiler.
<
LOCAL cStr
Line 4,671 ⟶ 5,054:
NEXT
RETURN cFinal == cStr</
{{out}}
<pre>
Line 4,685 ⟶ 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.
<
import Data.Char (toUpper)
Line 4,699 ⟶ 5,082:
main :: IO ()
main = mapM_ (\w -> print (w, not . null $ abc blocks (map toUpper w)))
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]</
{{out}}
Line 4,715 ⟶ 5,098:
Or, in terms of the bind operator:
<
import Data.List (delete)
Line 4,752 ⟶ 5,135:
words $
"BO XK DQ CP NA GT RE TG QD FS JW"
<> " HU VI AN OB ER FS LY PC ZM"</
{{Out}}
<pre>("",True)
Line 4,767 ⟶ 5,150:
Works in both languages:
<
blocks := ["bo","xk","dq","cp","na","gt","re","tg","qd","fs",
"jw","hu","vi","an","ob","er","fs","ly","pc","zm",&null]
Line 4,790 ⟶ 5,173:
}
}
end</
Sample run:
Line 4,804 ⟶ 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:'''
<
'rows cols'=. i.&.> $y
for_c. cols do.
Line 4,818 ⟶ 5,220:
)
abc=: *./@(+./)@reduce@(e."1~ ,)&toupper :: 0:</
'''Examples:'''
<
ExampleWords=: <;._2 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
Line 4,833 ⟶ 5,235:
"COmMOn" F
"SqUAD" T
"CoNfuSE" T</
'''Tacit version'''
<
uppc=:(-32*96&<*.123&>)&.(3&u:)
reduc=: ] delElem 1 i.~e."0 1
forms=: (1 - '' -: (reduc L:0/ :: (a:"_)@(<"0@],<@[))&uppc) L:0</
{{out}}
Line 4,863 ⟶ 5,265:
Another approach might be:
<
ExampleWords=: ;: 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
Line 4,870 ⟶ 5,272:
need=: #/.~ word,word
relevant=: (x +./@e."1 word) # x
candidates=: word,"1>,{ {relevant
+./(((#need){. #/.~)"1 candidates) */ .>:need
)</
Example use:
<
1
Blocks canform 1{::ExampleWords
Line 4,889 ⟶ 5,291:
1
Blocks canform 6{::ExampleWords
1</
Explanation:
Line 4,899 ⟶ 5,301:
For example:
<
1
word
Line 4,912 ⟶ 5,314:
ANN
AAA
AAN</
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, three of the candidates are valid, for this trivial example.)
Line 4,919 ⟶ 5,321:
{{trans|C}}
{{works with|Java|1.6+}}
<
import java.util.Collections;
import java.util.List;
Line 4,954 ⟶ 5,356:
return false;
}
}</
{{out}}
<pre>"": true
Line 4,969 ⟶ 5,371:
====Imperative====
The following method uses regular expressions and the string replace function to allow more support for older browsers.
<
function CheckWord(blocks, word) {
Line 5,006 ⟶ 5,408:
for(var i = 0;i<words.length;++i)
console.log(words[i] + ": " + CheckWord(blocks, words[i]));
</syntaxhighlight>
Result:
Line 5,020 ⟶ 5,422:
====Functional====
<
var strBlocks =
Line 5,067 ⟶ 5,469:
return strWords.split(' ').map(solution).join('\n');
})('A bark BooK TReAT COMMON squAD conFUSE');</
{{Out}}
<
bark -> BO NA RE XK
BooK: [no solution]
Line 5,075 ⟶ 5,477:
COMMON: [no solution]
squAD -> FS DQ HU NA QD
conFUSE -> CP BO NA FS HU FS RE</
===ES6===
====Imperative====
<
let blocks = characters.split(" ").map(pair => pair.split(""));
Line 5,111 ⟶ 5,513:
"CONFUSE"
].forEach(word => console.log(`${word}: ${isWordPossible(word)}`));
</syntaxhighlight>
Result:
Line 5,125 ⟶ 5,527:
====Functional====
{{Trans|Haskell}}
<
"use strict";
Line 5,191 ⟶ 5,593:
// MAIN ---
return main();
})();</
{{Out}}
<pre>["",true]
Line 5,203 ⟶ 5,605:
=={{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.<
# 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 5,232 ⟶ 5,634:
else .[1:] | abc($blks)
end
end;</
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</
{{Out}}
A : true
Line 5,249 ⟶ 5,651:
=={{header|Jsish}}==
Based on Javascript ES5 imperative solution.
<
/* 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";
Line 5,285 ⟶ 5,687:
can spell CONFUSE
=!EXPECTEND!=
*/</
{{out}}
Line 5,302 ⟶ 5,704:
=={{header|Julia}}==
<
function abc(str::AbstractString, list)
Line 5,320 ⟶ 5,722:
@printf("%-8s | %s\n", str, abc(str, list))
end
end</
{{out}}
Line 5,331 ⟶ 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}}
<
fun run() {
println("\"\": " + blocks.canMakeWord(""))
Line 5,371 ⟶ 5,830:
}
fun main(args: Array<String>) = ABC_block_checker.run()</
{{out}}
<pre>"": true
Line 5,381 ⟶ 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">
print "Rosetta Code - ABC problem (recursive solution)"
print
Line 5,427 ⟶ 5,941:
wend
end function
</syntaxhighlight>
{{out}}
<pre>
Line 5,449 ⟶ 5,963:
</pre>
===Procedural solution===
<syntaxhighlight lang="lb">
print "Rosetta Code - ABC problem (procedural solution)"
print
Line 5,583 ⟶ 6,097:
LetterOK=1
end sub
</syntaxhighlight>
{{out}}
<pre>
Line 5,606 ⟶ 6,120:
=={{header|Logo}}==
<
[J W] [H U] [V I] [A N] [O B] [E R] [F S] [L Y] [P C] [Z M]]
Line 5,626 ⟶ 6,140:
]
bye</
{{Out}}
Line 5,636 ⟶ 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}}==
<
{"B","O"}; {"X","K"}; {"D","Q"}; {"C","P"};
{"N","A"}; {"G","T"}; {"R","E"}; {"T","G"};
Line 5,668 ⟶ 6,292:
end
print(found)
end</
{{Output}}
Line 5,684 ⟶ 6,308:
<syntaxhighlight lang="m2000 interpreter">
Module ABC {
can_make_word("A")
Line 5,705 ⟶ 6,329:
}
ABC
</syntaxhighlight>
{{out}}
Line 5,717 ⟶ 6,341:
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}}==
<
local blocks, i, j, word, letterFound;
blocks := Array([["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"],
Line 5,741 ⟶ 6,433:
end proc:
seq(printf("%a: %a\n", i, canSpell(i)), i in [a, Bark, bOok, treat, COMMON, squad, confuse]);</
{{out}}
<pre>
Line 5,754 ⟶ 6,446:
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">
blocks=Partition[Characters[ToLowerCase["BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"]],2];
ClearAll[DoStep,ABCBlockQ]
Line 5,767 ⟶ 6,459:
DoStep[opts_List]:=Flatten[DoStep@@@opts,1]
ABCBlockQ[str_String]:=(FixedPoint[DoStep,{{Characters[ToLowerCase[str]],blocks,{}}}]=!={})
</syntaxhighlight>
{{Out}}
<pre>
Line 5,787 ⟶ 6,479:
=={{header|MATLAB}} / {{header|Octave}}==
<
combos = ['BO' ; 'XK' ; 'DQ' ; 'CP' ; 'NA' ; 'GT' ; 'RE' ; 'TG' ; 'QD' ; ...
'FS' ; 'JW' ; 'HU' ; 'VI' ; 'AN' ; 'OB' ; 'ER' ; 'FS' ; 'LY' ; ...
Line 5,812 ⟶ 6,504:
k = k+1;
end
end</
{{out}}
<pre>Can make word A.
Line 5,828 ⟶ 6,520:
Recursively checks if the word is possible if a block is removed from the array.
<syntaxhighlight lang="maxscript">
-- This is the blocks array
global GlobalBlocks = #("BO","XK","DQ","CP","NA", \
Line 5,927 ⟶ 6,619:
)
)
</syntaxhighlight>
'''Output:'''
<syntaxhighlight lang="maxscript">
iswordpossible "a"
true
Line 5,945 ⟶ 6,637:
iswordpossible "confuse"
true
</syntaxhighlight>
=== Non-recursive ===
<syntaxhighlight lang="maxscript">
fn isWordPossible2 word =
(
Line 5,980 ⟶ 6,672:
) else return false
)
</syntaxhighlight>
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 5,986 ⟶ 6,678:
Then:
<syntaxhighlight lang="maxscript">
iswordpossible "water"
true
iswordpossible2 "water"
false
</syntaxhighlight>
Non-recursive version quickly decides that it's not possible, even though it clearly is.
=={{header|Mercury}}==
<
:- interface.
:- import_module io.
Line 6,029 ⟶ 6,721:
io.format("can_make_word(""%s"") :- %s.\n",
[s(W), s(if P then "true" else "fail")], !IO)),
Words, !IO).</
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}}==
<
swap = function(list, index1, index2)
Line 6,060 ⟶ 6,752:
print out + ": " + canMakeWord(val, allBlocks)
end for
</syntaxhighlight>
=={{header|Miranda}}==
<syntaxhighlight lang="miranda">main :: [sys_message]
main = [Stdout (lay [word ++ ": " ++ show (canmakeword blocks word) | word <- tests])]
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}}⊂
<
func canMakeWord(blocks: seq[string]; word: string): bool =
Line 6,089 ⟶ 6,820:
echo()
when isMainModule: main()</
{{Out}}
<pre>Using the blocks BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
Line 6,108 ⟶ 6,839:
=={{header|Oberon-2}}==
Works with oo2c Version 2
<
MODULE ABCBlocks;
IMPORT
Line 6,192 ⟶ 6,923:
Out.String("confuse: ");Out.Bool(CanMakeWord("confuse"));Out.Ln;
END ABCBlocks.
</syntaxhighlight>
Output:
<pre>
Line 6,206 ⟶ 6,937:
=={{header|Objeck}}==
{{trans|Java}}
<
function : Main(args : String[]) ~ Nil {
blocks := ["BO", "XK", "DQ", "CP", "NA",
Line 6,251 ⟶ 6,982:
arr[j] := tmp;
}
}</
<pre>
"": true
Line 6,264 ⟶ 6,995:
=={{header|OCaml}}==
<
('B', 'O'); ('X', 'K'); ('D', 'Q'); ('C', 'P');
('N', 'A'); ('G', 'T'); ('R', 'E'); ('T', 'G');
Line 6,303 ⟶ 7,034:
"SQUAD", true;
"CONFUSE", true;
]</
{{Out}}
Line 6,319 ⟶ 7,050:
=={{header|Oforth}}==
<
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
Line 6,332 ⟶ 7,063:
]
false
;</
{{out}}
Line 6,342 ⟶ 7,073:
=={{header|OpenEdge/Progress}}==
<
/* List of blocks */
Line 6,444 ⟶ 7,175:
RETURN TRUE.
END FUNCTION.
</syntaxhighlight>
{{out}}
Line 6,458 ⟶ 7,189:
=={{header|Order}}==
<
#include <order/lib.h>
Line 6,620 ⟶ 7,351:
)
</syntaxhighlight>
{{out}}
Line 6,628 ⟶ 7,359:
=={{header|PARI/GP}}==
<
WORDS = ["A","Bark","BOOK","Treat","COMMON","SQUAD","conFUSE"];
Line 6,645 ⟶ 7,376:
}
for (i = 1, #WORDS, printf("%s\t%d\n", WORDS[i], can_make_word(WORDS[i])));</
Output:<pre>A 1
Line 6,659 ⟶ 7,390:
{{works with|Free Pascal|2.6.2}}
<syntaxhighlight lang="pascal">
#!/usr/bin/instantfpc
//program ABCProblem;
Line 6,725 ⟶ 7,456:
TestABCProblem('SQUAD');
TestABCProblem('CONFUSE');
END.</
{{out}}
Line 6,749 ⟶ 7,480:
=={{header|Perl}}==
Recursive solution that can handle characters appearing on different blocks:
<
use warnings;
use strict;
Line 6,774 ⟶ 7,505:
}
return
}</
<p>Testing:
<
my @blocks1 = qw(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM);
Line 6,789 ⟶ 7,520:
my @blocks2 = qw(US TZ AO QA);
is(can_make_word('auto', @blocks2), 1);
</syntaxhighlight>
===Regex based alternate===
<
use strict; # https://rosettacode.org/wiki/ABC_Problem
Line 6,807 ⟶ 7,538:
while $blocks =~ /\w?$letter\w?/gi;
return 'False';
}</
{{out}}
<pre>
Line 6,821 ⟶ 7,552:
=={{header|Phix}}==
Recursive solution which also solves the extra problems on the discussion page.
<!--<
<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>
Line 6,857 ⟶ 7,588:
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</
{{out}}
<pre>
Line 6,874 ⟶ 7,605:
=={{header|PHP}}==
<syntaxhighlight lang="php">
<?php
$words = array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse");
Line 6,903 ⟶ 7,634:
echo canMakeWord($word) ? "True" : "False";
echo "\r\n";
}</
{{out}}
<pre>
Line 6,917 ⟶ 7,648:
=={{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.
<
test_it(check_word),
test_it(check_word2),
Line 7,026 ⟶ 7,757:
block(p,c).
block(z,m).
</syntaxhighlight>
{{out}}
Line 7,100 ⟶ 7,831:
=={{header|PicoLisp}}==
Mapping and recursion.
<
'((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 7,132 ⟶ 7,863:
(println Word (abc Word *Blocks) (abcR Word *Blocks)) )
(bye)</
=={{header|PL/I}}==
===version 1===
<
declare word character (20) varying, blocks character (200) varying initial
Line 7,161 ⟶ 7,892:
end;
end ABC;</
<pre>
A true
Line 7,173 ⟶ 7,904:
===version 2===
<
abc: Proc Options(main);
/* REXX --------------------------------------------------------------
Line 7,293 ⟶ 8,024:
End;
End;</
{{out}}
<pre>'$' cannot be spelt.
Line 7,305 ⟶ 8,036:
=={{header|PL/M}}==
<
/* ABC PROBLEM ON $-TERMINATED STRING */
Line 7,364 ⟶ 8,095:
CALL BDOS(0,0);
EOF</
{{out}}
<pre>A: YES
Line 7,377 ⟶ 8,108:
Works with PowerBASIC 6 Console Compiler
<
#DIM ALL
'
Line 7,532 ⟶ 8,263:
END IF
END FUNCTION
</syntaxhighlight>
{{out}}
<pre>$ FALSE
Line 7,546 ⟶ 8,277:
=={{header|PowerShell}}==
<
.Synopsis
ABC Problem
Line 7,662 ⟶ 8,393:
{
test-blocks -testword $word -Verbose
}</
{{out}}
<pre>
Line 7,728 ⟶ 8,459:
Works with SWI-Prolog 6.5.3
<
maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).
Line 7,750 ⟶ 8,481:
( select([H, _], L, L1); select([_, H], L, L1)),
can_makeword(L1, T).
</syntaxhighlight>
{{out}}
<pre> ?- abc_problem.
Line 7,771 ⟶ 8,502:
{{works with|SWI Prolog 7}}
<
abathslib(protelog/composer) ]).
Line 7,788 ⟶ 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.</
Demonstration:
<
true.
?- can_build_word("BARK").
Line 7,806 ⟶ 8,537:
true.
?- can_build_word("CONFUSE").
true.</
=={{header|PureBasic}}==
===PureBasic: Iterative===
<
#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
Line 7,841 ⟶ 8,572:
PrintN(can_make_word("SqUAD"))
PrintN(can_make_word("COnFUSE"))
Input()</
===PureBasic: Recursive===
<
Macro test(t)
Line 7,863 ⟶ 8,594:
test("a") : test("BaRK") : test("BOoK") : test("TREAt")
test("cOMMON") : test("SqUAD") : test("COnFUSE")
Input()</
{{out}}
<pre>a = True
Line 7,876 ⟶ 8,607:
===Python: Iterative, with tests===
<
'''
Note that this code is broken, e.g., it won't work when
Line 7,945 ⟶ 8,676:
["", "a", "baRk", "booK", "treat",
"COMMON", "squad", "Confused"]))
</syntaxhighlight>
{{out}}
Line 7,951 ⟶ 8,682:
===Python: Recursive===
<
def _abc(word, blocks):
Line 7,975 ⟶ 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)))</
{{out}}
Line 7,988 ⟶ 8,719:
===Python: Recursive, telling how===
<
if not w: return []
Line 8,003 ⟶ 8,734:
for w in ", A, bark, book, treat, common, SQUAD, conFUsEd".split(', '):
print '\'' + w + '\'' + ' ->', abc(w, blocks)</
{{out}}
Line 8,020 ⟶ 8,751:
=={{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.
<
WORDS:string`A`BARK`BOOK`TREAT`COMMON`SQUAD`CONFUSE
Line 8,026 ⟶ 8,757:
$[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] }</
{{out}}
<
1101011b</
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.
Line 8,037 ⟶ 8,768:
To meet the requirement for case-insensitivity and to display the results, apply the above within a wrapper.
<
cmwi:{(`$x), `false`true cmw . upper each(x;y) }</
{{out}}
<
A true
bark true
Line 8,047 ⟶ 8,778:
COMMON false
squad true
CONFUSE true</
* [https://code.kx.com/q/ref/ Language Reference]
* [https://code.kx.com/q/learn/pb/abc-problem/ The Q Playbook: ABC problem – analysis]
Line 8,059 ⟶ 8,790:
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.
<
$ "JWHUVIANOBERFSLYPCZM"
join ] constant is blocks ( --> $ )
Line 8,078 ⟶ 8,809:
[ drop dip not
conclude ] ]
drop echotruth ] is can_make_word ( $ --> )</
'''Testing in the Quackery shell:'''
Line 8,123 ⟶ 8,854:
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.
<
witheach
[ over -1 peek
Line 8,174 ⟶ 8,905:
bailed dup
if [ dip 2drop ]
echotruth ] is can_make_word ( $ --> )</
'''Testing in the Quackery shell:'''
Identical to iterative solution above.
Line 8,183 ⟶ 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.
<
c("X","K"),
c("D","Q"),
Line 8,225 ⟶ 8,956:
"COMMON",
"SQUAD",
"CONFUSE"))</
{{out}}
Line 8,233 ⟶ 8,964:
===Without recursion===
Second version without recursion and giving every unique combination of blocks for each word:
<
x <- toupper(x)
charList <- strsplit(x, character(0))
Line 8,253 ⟶ 8,984:
"COMMON",
"SQUAD",
"CONFUSE"))</
{{out}}
<pre>$A
Line 8,337 ⟶ 9,068:
So '(can-make-word? "")' is true for me.
<
(define block-strings
(list "BO" "XK" "DQ" "CP" "NA"
Line 8,379 ⟶ 9,110:
(check-false (can-make-word? "COMMON"))
(check-true (can-make-word? "SQUAD"))
(check-true (can-make-word? "CONFUSE")))</
{{out}}
Line 8,395 ⟶ 9,126:
{{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"
my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
can-spell-word $word.uc.comb.list, @regex;
Line 8,415 ⟶ 9,146:
for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
say "$_ &can-spell-word($_, @b)";
}</
{{out}}
<pre>A True
Line 8,426 ⟶ 9,157:
=={{header|RapidQ}}==
<
dim InWord as string
Line 8,452 ⟶ 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>
{{out}}
<pre>Can make: A = TRUE
Line 8,464 ⟶ 9,195:
=={{header|Red}}==
<
test: func [ s][
p: copy "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
Line 8,480 ⟶ 9,211:
print reduce [ pad copy word 8 ":" test word]
]
</syntaxhighlight>
{{out}}
<pre>
Line 8,491 ⟶ 9,222:
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===
<
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'
Line 8,514 ⟶ 9,290:
end /*try*/ /* [↑] end of a "TRY" permute. */
say right( arg(1), 30) right( word( "can't can", (n==L) + 1), 6) 'be spelt.'
return</
{{out|output|text= when using the default inputs:}}
<pre>
Line 8,527 ⟶ 9,303:
===version 2===
<
* 10.01.2014 Walter Pachl counts the number of possible ways
* 12.01.2014 corrected date and output
Line 8,629 ⟶ 9,405:
used.w=1
End
Return 1</
{{out}}
<pre>'' cannot be spelt.
Line 8,710 ⟶ 9,486:
=={{header|Ring}}==
<
Words = [ :A, :BARK, :BOOK, :TREAT, :COMMON, :SQUAD, :CONFUSE ]
Line 8,733 ⟶ 9,509:
if found = false return false ok
next
return true</
{{Out}}
<pre>
Line 8,750 ⟶ 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.
<
words.each do |word|
Line 8,761 ⟶ 9,638:
puts "#{word.inspect}: #{res}"
end
</syntaxhighlight>
{{Out}}
<pre>
Line 8,775 ⟶ 9,652:
=={{header|Run BASIC}}==
<
makeWord$ = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse"
b = int((len(blocks$) /3) + 1)
Line 8,799 ⟶ 9,676:
print wrd$;chr$(9);
if n = len(wrd$) then print " True" else print " False"
next i</
<pre>A True
BARK True
Line 8,810 ⟶ 9,687:
=={{header|Rust}}==
This implementation uses a backtracking search.
<
fn rec_can_make_word(index: usize, word: &str, blocks: &[&str], used: &mut[bool]) -> bool {
Line 8,839 ⟶ 9,716:
}
}
</syntaxhighlight>
{{Out}}
<pre>
Line 8,852 ⟶ 9,729:
=={{header|Scala}}==
{{libheader|Scala}}<
protected class Block(face1: Char, face2: Char) {
Line 8,901 ⟶ 9,778:
words.foreach(w => println(s"$w can${if (isMakeable(w, blocks)) " " else "not "}be made."))
}</
=={{header|Scheme}}==
In R5RS:
<
'((#\B #\O) (#\X #\K) (#\D #\Q) (#\C #\P) (#\N #\A)
(#\G #\T) (#\R #\E) (#\T #\G) (#\Q #\D) (#\F #\S)
Line 8,945 ⟶ 9,822:
(display word)
(newline))
*words*)</
{{out}}
<pre>
Line 8,958 ⟶ 9,835:
=={{header|Seed7}}==
<
const func boolean: canMakeWords (in array string: blocks, in string: word) is func
Line 8,991 ⟶ 9,868:
writeln(word rpad 10 <& canMakeWords(word));
end for;
end func;</
{{out}}
Line 9,006 ⟶ 9,883:
=={{header|SenseTalk}}==
<
put [
Line 9,046 ⟶ 9,923:
return True
end CanMakeWord</
<
"A",
"BARK",
Line 9,058 ⟶ 9,935:
]
put CanMakeWord(word)
end repeat</
=={{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===
<
import <Utilities/Sequence.sl>;
Line 9,090 ⟶ 9,997:
letter when ascii >= 65 and ascii <= 90
else
intToAscii(ascii - 32);</
{{out}}
Line 9,105 ⟶ 10,012:
===RegEx Version ===
<
import <Utilities/Sequence.sl>;
import <RegEx/RegEx.sl>;
Line 9,135 ⟶ 10,042:
letter when ascii >= 65 and ascii <= 90
else
intToAscii(ascii - 32);</
=={{header|Sidef}}==
{{trans|Perl}}
<
blocks.map! { |b| b.uc.chars.sort.join }.freq!
Line 9,155 ⟶ 10,062:
return false;
}(word.uc.chars, blocks)
}</
Tests:
<
var b2 = %w(US TZ AO QA)
Line 9,176 ⟶ 10,083:
say ("%7s -> %s" % (t[0], bool));
assert(bool == t[1])
}</
{{out}}
Line 9,191 ⟶ 10,098:
=={{header|Simula}}==
<
BEGIN
Line 9,287 ⟶ 10,194:
END.
</syntaxhighlight>
{{out}}
<pre>A => T OK
Line 9,300 ⟶ 10,207:
=={{header|Smalltalk}}==
Recursive solution. Tested in Pharo.
<
ABCPuzzle>>test
#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
Line 9,322 ⟶ 10,229:
(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
^ false
</syntaxhighlight>
{{out}}
<pre>
Line 9,338 ⟶ 10,245:
=={{header|SNOBOL4}}==
{{works with|SNOBOL4, SPITBOL for Linux}}
<syntaxhighlight lang="snobol4">
* Program: abc.sbl,
* To run: sbl -r abc.sbl
Line 9,407 ⟶ 10,314:
P C
Z M
</syntaxhighlight>
{{out}}
<pre>
Line 9,427 ⟶ 10,334:
=={{header|SPAD}}==
{{works with|FriCAS, OpenAxiom, Axiom}}
<syntaxhighlight 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 9,452 ⟶ 10,359:
[canMakeWord?(s,blocks) for s in Example]
</syntaxhighlight>
Programming details:[http://fricas.github.io/book.pdf UserGuide]
Line 9,466 ⟶ 10,373:
=={{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"),
Line 9,500 ⟶ 10,407:
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
Line 9,507 ⟶ 10,414:
=={{header|Swift}}==
<
func Blockable(str: String) -> Bool {
Line 9,539 ⟶ 10,446:
for str in [ "A", "BARK", "BooK", "TrEaT", "comMON", "sQuAd", "Confuse" ] {
println("'\(str)' \(CanOrNot(Blockable(str))) be spelled with blocks.")
}</
{{out}}
<pre>
Line 9,552 ⟶ 10,459:
{{works with|Swift|3.0.2}}
<
func canMake(word: String) -> Bool {
Line 9,573 ⟶ 10,480:
let words = ["a", "bARK", "boOK", "TreAt", "CoMmon", "SquAd", "CONFUse"]
words.forEach { print($0, canMake(word: $0)) }</
{{out}}
<pre>
Line 9,587 ⟶ 10,494:
=={{header|Tcl}}==
{{works with|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 9,607 ⟶ 10,514:
foreach word {"" A BARK BOOK TREAT COMMON SQUAD CONFUSE} {
puts [format "Can we spell %9s? %s" '$word' [abc $word]]
}</
{{out}}
<pre>
Line 9,618 ⟶ 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}}==
<
set result = *
loop word = words
Line 9,638 ⟶ 10,584:
set out = concat (word, " ", cond)
set result = append (result, out)
endloop</
{{out}}
<pre>A true
Line 9,650 ⟶ 10,596:
=={{header|TXR}}==
<
(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 9,696 ⟶ 10,642:
@(if (can-make-word w) "True" "False")
@(end)
@(end)</
Run:
Line 9,725 ⟶ 10,671:
=={{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>
Line 9,832 ⟶ 10,814:
}
</syntaxhighlight>
{{out}}
Line 9,859 ⟶ 10,841:
{{works with|bash}}
<
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 9,897 ⟶ 10,879:
can_build_word "$word" "${blocks[@]}" && ans=yes || ans=no
printf "%s\t%s\n" "$word" $ans
done</
{{out}}
Line 9,913 ⟶ 10,895:
'''String-based solution'''
<syntaxhighlight lang="utfool">
···
http://rosettacode.org/wiki/ABC_Problem
Line 9,941 ⟶ 10,923:
i: blocks.indexOf (word.substring 0, 1), i + 3
return solution
</syntaxhighlight>
'''Collection-based solution'''
<syntaxhighlight lang="utfool">
···
http://rosettacode.org/wiki/ABC_Problem
Line 9,980 ⟶ 10,962:
Collections.swap blocks, 0, i
return false
</syntaxhighlight>
=={{header|VBA}}==
<syntaxhighlight lang="vb">
Option Explicit
Line 10,019 ⟶ 11,001:
ABC = (NbInit = (myColl.Count + Len(myWord)))
End Function
</syntaxhighlight>
{{out}}
<pre>
Line 10,029 ⟶ 11,011:
>>> 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}}
<
var r // recursive
Line 10,060 ⟶ 11,093:
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"]) {
}</
{{out}}
Line 10,075 ⟶ 11,108:
=={{header|XPL0}}==
<
char Side1, Side2;
Line 10,103 ⟶ 11,136:
Text(0, if CanMakeWord(Words(J)) then "True" else "False"); CrLf(0);
];
]</
{{out}}
Line 10,117 ⟶ 11,150:
=={{header|Yabasic}}==
<
sub canMake(letters$, word$)
Line 10,144 ⟶ 11,177:
print "common = ", canMake(letters$, "common") // 0
print "squad = ", canMake(letters$, "squad") // 1
print "confuse = ", canMake(letters$, "confuse") // 1</
=={{header|zkl}}==
{{trans|C}}
<
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM", );
Line 10,166 ⟶ 11,199:
foreach word in (T("","A","BarK","BOOK","TREAT","COMMON","SQUAD","Confuse","abba")){
can_make_word(word).println(": ",word);
}</
{{out}}
<pre>
Line 10,181 ⟶ 11,214:
=={{header|zonnon}}==
<
module Main;
type
Line 10,269 ⟶ 11,302:
CanMakeWord("confuse");
end Main.
</syntaxhighlight>
{{Out}}
<pre>
Line 10,281 ⟶ 11,314:
=={{header|ZX Spectrum Basic}}==
<
20 READ p
30 FOR c=1 TO p
Line 10,301 ⟶ 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</
{{out}}
<pre>
|