ABC problem: Difference between revisions
m
→{{header|SuperCollider }}
Ttmrichter (talk | contribs) |
Music Coder (talk | contribs) |
||
| (30 intermediate revisions by 16 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 1,324 ⟶ 1,351:
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
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===
Line 3,639 ⟶ 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,706 ⟶ 3,829:
=={{header|Elena}}==
ELENA
<syntaxhighlight lang="elena">import system'routines;
import system'collections;
import system'culture;
import extensions;
import extensions'routines;
Line 3,718 ⟶ 3,842:
var list := ArrayList.load(blocks);
^ nil == (cast string(self)).
{
var index := list.indexOfElement
Line 3,747 ⟶ 3,871:
e.next();
words.forEach::(word)
{
console.printLine("can make '",word,"' : ",word.canMakeWordFrom(blocks));
Line 3,793 ⟶ 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>
Line 4,610 ⟶ 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
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
Line 4,655 ⟶ 4,858:
{{output}}
<pre>
Can blocks spell Bark : 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}}==
Line 4,955 ⟶ 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>
Line 5,021 ⟶ 5,272:
need=: #/.~ word,word
relevant=: (x +./@e."1 word) # x
candidates=: word,"1>,{ {relevant
+./(((#need){. #/.~)"1 candidates) */ .>:need
)</syntaxhighlight>
Line 5,482 ⟶ 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}}
Line 5,853 ⟶ 6,161:
:- public(spell_no_spell/3).
:- uses(character, [lower_upper/2,
% public interface
can_spell(Atom) :-
to_lower(
spell_no_spell(Words, Spellable, Unspellable) :-
Line 5,873 ⟶ 6,178:
can_spell(Blocks0, [H|T]) :-
( list::selectchk(b(H,_), Blocks0, Blocks1)
; list::selectchk(b(_,H), Blocks0, Blocks1)
),
can_spell(Blocks1, T).
to_lower(
meta::map(
[C,L] >> (is_upper_case(C)
).
:- end_object.
Line 5,894 ⟶ 6,201:
:- public(run/0).
:- uses(logtalk, [print_message(information, blocks, Message) as print(Message)]).
Line 5,901 ⟶ 6,207:
word_list(WordList),
blocks(BlockSet)::spell_no_spell(WordList, S, U),
print(
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),
word_list(['', 'A', 'bark', 'bOOk', 'treAT', 'COmmon', 'sQuaD', 'CONFUSE']).
:- end_object.
Line 5,925 ⟶ 6,225:
<syntaxhighlight lang="logtalk">
:- initialization((
% libraries
logtalk_load(meta(loader)),
logtalk_load(
% application
logtalk_load([blocks, blocks_test])
)).
</syntaxhighlight>
Line 5,951 ⟶ 6,245:
?- 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:
%
% - 'COmmon'
true.
Line 8,922 ⟶ 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,592 ⟶ 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,036 ⟶ 10,411:
<pre>val it = [true, true, false, true, false, true, true]: bool list
val it = [true, false, true]: bool list
</pre>
=={{header|SuperCollider }}==
{{works with|SuperCollider|3.13.0}}
Submitted to Rosetta Code 2024-06-18 by: Music Coder.
<syntaxhighlight lang="supercollider">
// ==========================================================================
// START:SuperCollider solution to Rosetta Code TASK: ABC_problem
// ==========================================================================
(
/* ## BY: Music Coder : 2024-06-18 ##
https://rosettacode.org/wiki/ABC_problem
Given a list of blocks - with two letters on each block
and given a list of words - report which words can/cannot be constructed
Case of letters can be ignored.
Approach: two loops - nested:
outer loop: iterate over each character in the word:
feed the current character into the inner loop
inner loop: iterate over the list of unused blocks:
if the current character is found on a block:
remove the block from the list
and exit the inner loop
if the end of the inner loop is reached
mark this word as failed
and exit both loops
NOTE: since 'block' is a METHOD in SuperCollider (used to created a breakable loop)
to avoid confusion the data items with two letters will be called 'tiles'.
*/
// FUNCTION: to solve the problem
var canMakeWord = {|rawWord, tileList|
var word = rawWord.toUpper; // make word upper case;
var unused = List.newFrom(tileList); // list of unused tiles
var madeWord = block {|outerBreak| // to BREAK from outer-loop assign to variable outerBreak
word.do {|char| // loop over characters in the word ...
// inner-block
block {|innerBreak| // to BREAK from inner-loop assign to variable innerBreak
unused.do {|tile, index| // loop over blocks in the unused list
if (tile.contains(char), // if we find a tile for this character ...
{ unused.removeAt(index); // remove the tile from the 'unused' list
innerBreak.value(1); // ... and BREAK from the inner loop.
// we don't care about the value assigned to innerBreak -- we just need to BREAK
}); // end-of: if
// continue to the next tile
}; // end-of: do inner-loop
// have gone through all of the tiles for current char without a match!
outerBreak.value(false); // set block=false => madeWord and BREAK from outer-loop
}; // end-of: inner-block
}; // endof: do outer-loop;
true; // set block value to true => madeWord = true;
}; // end-of: outer-block;
madeWord; // return true or false
};
// FUNCTION: Demonstrate and test the solution
var demoAndTest = {|tilesString, wordsList, shouldFailList|
// split the blocks-string into a set of strings & make upper-case
// NOTICE the strange split notation $space to split on space
var tileList = List.newFrom(tilesString.toUpper.split($ ));
// make a SET of words that should fail - so we can look them up easily
var shouldFailSet = Set.newFrom(shouldFailList);
wordsList.do({|word| // loop over the list of words
// CALL the function: canMakeWord
var made = canMakeWord.(word, tileList);
// align words true/false
var word_made = if (made, "true ", "FALSE");
// check to see if this word is in the should-fail-set
var shouldFail = shouldFailSet.includes(word.toUpper);
// did the make function have the expected result?
var pass = if ( (made && shouldFail) || (not(made) && not(shouldFail)), "FAILED", "passed");
// wrap word in single-quotes and align
var padWord = ("'"++word++"'").padRight(12);
postf("word=% word-made=% test:%\n", padWord, word_made, pass);
});
};
// input data
var tiles_string = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
var words_list = ["a", "BARK", "booK", "tReat", "cOmmOn", "squad", "ConFuseD"];
var should_fail = ["BOOK", "COMMON"];
// function to demostrate and test the solution
demoAndTest.(tiles_string, words_list, should_fail);
"\n";
)
// ==========================================================================
// **END:SuperCollider solution to Rosetta Code TASK: ABC problem
// ==========================================================================
</syntaxhighlight>
{{out}}
<pre>
word='a' word-made=true test:passed
word='BARK' word-made=true test:passed
word='booK' word-made=FALSE test:passed
word='tReat' word-made=true test:passed
word='cOmmOn' word-made=FALSE test:passed
word='squad' word-made=true test:passed
word='ConFuseD' word-made=true test:passed
</pre>
Line 10,305 ⟶ 10,784:
For x = 0 To Len (a)-1 : @b(x) = Or(Peek(a, x), Ord(" ")) : Next
' push words onto stack
Push
Do While Used() ' as long as words on the stack
Line 10,692 ⟶ 11,170:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
var r // recursive
Line 10,719 ⟶ 11,197:
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"]) {
}</syntaxhighlight>
| |||