ABC problem: Difference between revisions
Add ABC
Not a robot (talk | contribs) (Add ABC) |
|||
| (23 intermediate revisions by 15 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,893 ⟶ 6,201:
:- public(run/0).
:- uses(logtalk, [print_message(information, blocks, Message) as print(Message)]).
Line 5,900 ⟶ 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,929 ⟶ 6,230:
logtalk_load(types(loader)),
% application
logtalk_load([blocks, blocks_test])
)).
</syntaxhighlight>
Line 5,944 ⟶ 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,915 ⟶ 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,585 ⟶ 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,298 ⟶ 10,680:
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,685 ⟶ 11,066:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
var r // recursive
Line 10,712 ⟶ 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"]) {
}</syntaxhighlight>
| |||