Rosetta Code

ABC problem: Difference between revisions

Page Discussion

ABC problem (view source)

Revision as of 16:15, 14 March 2024

4,664 bytes added ,  2 months ago
Add ABC
(Refactoring and updating of earlier code)
(Add ABC)
 
(10 intermediate revisions by 8 users not shown)
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!}}==
Line 3,697 ⟶ 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}}==
Line 3,777 ⟶ 3,842:
var list := ArrayList.load(blocks);
^ nil == (cast string(self)).toUpper().seekEach::(ch)
{
var index := list.indexOfElement
Line 3,806 ⟶ 3,871:
e.next();
words.forEach::(word)
{
console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
Line 4,752 ⟶ 4,817:
 
=={{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(0) ) - 1
t1 = mid( mda_objectmda(j), 0, 1 ) : t2 = mid( mda_objectmda(j), 1, 1 )
if ( fn StringIsEqual( mid( w, i, 1 ), t1 ) ) then s = fn StringByAppendingString( s, t1 ) : mda(j) = @" " : exit forbreak
if ( fn StringIsEqual( mid( w, i, 1 ), t2 ) ) then s = fn StringByAppendingString( s, t2 ) : mda(j) = @" " : exit forbreak
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 iw =in 0 to len(words) -1
printf @"Can blocks spell %7s : %@", fn StringUTF8String( words[i]w ), fn CanBlocksSpell( words[i]w )
next
 
NSLog( @"%@", fn WindowPrintViewString( 1 ) )
 
HandleEvents
Line 4,792 ⟶ 4,869:
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}}==
Line 5,088 ⟶ 5,191:
=={{header|Insitux}}==
<syntaxhighlight lang="insitux">
(function in-block? c
(var find-idx #(when (let found (find % %1)) (idx %1 found)))
(function in-block? c (when (let block-idx (find-idx (substr? (upper-case c)) rem-blocks)) (var! rem-blocks drop block-idx)))
(var! rem-blocks drop block-idx)))
 
(function can-make-word word
Line 5,095 ⟶ 5,199:
(.. and (map in-block? word)))
 
(join ", " (map #(str % " =-> " (can-make-word %)) ["A" "bark" "Book" "TREAT" "Common" "squaD" "CoNFuSe"])) ; Notice case insensitivity
(map #(str % " => " (can-make-word %)))
 
(join ", "))
</syntaxhighlight>
{{out}}
Line 9,117 ⟶ 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}}==
Line 9,787 ⟶ 9,937:
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===
Line 10,500 ⟶ 10,680:
For x = 0 To Len (a)-1 : @b(x) = Or(Peek(a, x), Ord(" ")) : Next
' push words onto stack
Push Dup("A"), Dup("Bark"), Dup("Book"), Dup("Treat"), "Common", "Squad", "Confuse"
Push Dup("Common"), Dup("Squad"), Dup("Confuse")
 
Do While Used() ' as long as words on the stack
Line 10,887 ⟶ 11,066:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
 
var r // recursive
Line 10,914 ⟶ 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"]) {
SystemFmt.print("%(Fmt.$-7s $s(-7", word)), %(sp.call(word))")
}</syntaxhighlight>
 
Not a robot
2,093

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/352263...361890"