Update all new Tasks

Task/ABC-Problem/00DESCRIPTION

@@ -0,0 +1,48 @@
+You are given a collection of ABC blocks. Just like the ones you had when you were a kid. There are twenty blocks with two letters on each block. You are guaranteed to have a complete alphabet amongst all sides of the blocks. The sample blocks are:
+
+:((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))
+
+The goal of this task is to write a function that takes a string and can determine whether you can spell the word with the given collection of blocks.
+The rules are simple:
+
+#Once a letter on a block is used that block cannot be used again
+#The function should be case-insensitive
+# Show your output on this page for the following words:
+
+;Example:
+
+<lang python>
+    >>> 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
+</lang>

Task/ABC-Problem/Ada/abc-problem.ada

@@ -0,0 +1,78 @@
+with Ada.Characters.Handling;
+use Ada.Characters.Handling;
+
+
+package Abc is
+    type Block_Faces is array(1..2) of Character;
+    type Block_List is array(positive range <>) of Block_Faces;
+    function Can_Make_Word(W: String; Blocks: Block_List) return Boolean;
+end Abc;
+
+
+package body Abc is
+
+function Can_Make_Word(W: String; Blocks: Block_List) return Boolean is
+    Used : array(Blocks'Range) of Boolean := (Others => False);
+    subtype wIndex is Integer range W'First..W'Last;
+    wPos : wIndex;
+begin
+    if W'Length = 0 then
+        return True;
+    end if;
+    wPos := W'First;
+    while True loop
+        declare
+            C : Character := To_Upper(W(wPos));
+            X : constant wIndex := wPos;
+        begin
+            for I in Blocks'Range loop
+                if (not Used(I)) then
+                    if C = To_Upper(Blocks(I)(1)) or C = To_Upper(Blocks(I)(2)) then
+                        Used(I) := True;
+                        if wPos = W'Last then
+                            return True;
+                        end if;
+                        wPos := wIndex'Succ(wPos);
+                        exit;
+                    end if;
+                end if;
+            end loop;
+            if X = wPos then
+                return False;
+            end if;
+        end;
+    end loop;
+    return False;
+end Can_Make_Word;
+
+end Abc;
+
+with Ada.Text_IO, Ada.Strings.Unbounded, Abc;
+use Ada.Text_IO, Ada.Strings.Unbounded, Abc;
+
+procedure Abc_Problem is
+    Blocks : Block_List := (
+          ('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')
+    );
+    function "+" (S : String) return Unbounded_String renames To_Unbounded_String;
+    words : array(positive range <>) of Unbounded_String := (
+          +"A"
+        , +"BARK"
+        , +"BOOK"
+        , +"TREAT"
+        , +"COMMON"
+        , +"SQUAD"
+        , +"CONFUSE"
+        -- Border cases:
+        -- , +"CONFUSE2"
+        -- , +""
+    );
+begin
+    for I in words'Range loop
+        Put_Line ( To_String(words(I)) & ": " & Boolean'Image(Can_Make_Word(To_String(words(I)),Blocks)) );
+    end loop;
+end Abc_Problem;

Task/ABC-Problem/AutoHotkey/abc-problem-1.ahk

@@ -0,0 +1,24 @@
+isWordPossible(blocks, word){
+	o := {}
+	loop, parse, blocks, `n, `r
+		o.Insert(A_LoopField)
+	loop, parse, word
+		if !(r := isWordPossible_contains(o, A_LoopField, word))
+			return 0
+	return 1
+}
+isWordPossible_contains(byref o, letter, word){
+	loop 2 {
+		for k,v in o
+			if Instr(v,letter)
+			{
+				StringReplace, op, v,% letter
+				if RegExMatch(op, "[" word "]")
+					sap := k
+				else added := 1 , sap := k
+				if added
+					return "1" o.remove(sap)
+			}
+		added := 1
+	}
+}

Task/ABC-Problem/AutoHotkey/abc-problem-2.ahk

@@ -0,0 +1,38 @@
+blocks := "
+(
+BO
+XK
+DQ
+CP
+NA
+GT
+RE
+TG
+QD
+FS
+JW
+HU
+VI
+AN
+OB
+ER
+FS
+LY
+PC
+ZM
+)"
+
+wordlist := "
+(
+A
+BARK
+BOOK
+TREAT
+COMMON
+SQUAD
+CONFUSE
+)"
+
+loop, parse, wordlist, `n
+	out .= A_LoopField " - " isWordPossible(blocks, A_LoopField) "`n"
+msgbox % out

Task/ABC-Problem/BBC-BASIC/abc-problem.bbc

@@ -0,0 +1,22 @@
+      BLOCKS$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
+      PROCcan_make_word("A")
+      PROCcan_make_word("BARK")
+      PROCcan_make_word("BOOK")
+      PROCcan_make_word("TREAT")
+      PROCcan_make_word("COMMON")
+      PROCcan_make_word("SQUAD")
+      PROCcan_make_word("Confuse")
+      END
+
+      DEF PROCcan_make_word(word$)
+      LOCAL b$,p%
+      b$=BLOCKS$
+      PRINT word$ " -> ";
+      p%=INSTR(b$,CHR$(ASCword$ AND &DF))
+      WHILE p%>0 AND word$>""
+        MID$(b$,p%-1+(p% MOD 2),2)=".."
+        word$=MID$(word$,2)
+        p%=INSTR(b$,CHR$(ASCword$ AND &DF))
+      ENDWHILE
+      IF word$>"" PRINT "False" ELSE PRINT "True"
+      ENDPROC

Task/ABC-Problem/Batch-File/abc-problem.bat

@@ -0,0 +1,62 @@
+@echo off
+::abc.bat
+::
+::Batch file to evaluate if a given string can be represented with a set of
+::20 2-faced blocks.
+::
+
+::Check if a string was provided
+if "%1"=="" goto ERROR
+
+::Define blocks. Separate blocks by ':', and terminat with '::'
+set "FACES=BO:XK:DQ:CP:NA:GT:RE:TG:QD:FS:JW:HU:VI:AN:OB:ER:FS:LY:PC:ZM::"
+set INPUT=%1
+set "COUNTER=0"
+
+::The main loop steps through the input string, checking if an available
+::block exists for each character
+:LOOP_MAIN
+
+  ::Get character, increase counter, and test if there are still characters
+  call set "char=%%INPUT:~%COUNTER%,1%%"
+  set /a "COUNTER+=1"
+  if "%CHAR%"=="" goto LOOP_MAIN_END
+
+  set "OFFSET=0"
+  :LOOP_2
+
+    ::Read in two characters (one block)
+    call set "BLOCK=%%FACES%:~%OFFSET%,2%%"
+
+    ::Test if the all blocks were checked. If so, no match was found
+    if "%BLOCK%"==":" goto FAIL
+
+    ::Test if current input string character is in the current block
+    if /i "%BLOCK:~0,1%"=="%CHAR%" goto FOUND
+    if /i "%BLOCK:~1,1%"=="%CHAR%" goto FOUND
+
+    ::Increase offset to point to the next block
+    set /a "OFFSET+=3"
+
+  goto LOOP_2
+  :LOOP_2_END
+
+  ::If found, blank out the block used
+  :FOUND
+  call set "FACES=%%FACES:%BLOCK%:=  :%%"
+
+goto LOOP_MAIN
+:LOOP_MAIN_END
+
+echo %0: It is possible to write the '%INPUT%' with my blocks.
+goto END
+
+:FAIL
+echo %0: It is NOT possible to write the '%INPUT%' with my blocks.
+goto END
+
+:ERROR
+echo %0: Please enter a string to evaluate
+echo.
+
+:END

Task/ABC-Problem/Bracmat/abc-problem.bracmat

@@ -0,0 +1,48 @@
+(
+  ( can-make-word
+  =   ABC 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)
+        : ?blocks
+      & ( ABC
+        =   letter blocks A Z
+          .   !arg:(.?)
+            |   !arg:(@(?:%?letter ?arg).?blocks)
+              &   !blocks
+                :   ?
+                  + ?*(? !letter ?:?block)
+                  + (?&ABC$(!arg.!blocks+-1*!block))
+        )
+      &   out
+        $ ( !arg
+            ( ABC$(upp$!arg.!blocks)&yes
+            | no
+            )
+          )
+  )
+& can-make-word'A
+& can-make-word'BARK
+& can-make-word'BOOK
+& can-make-word'TREAT
+& can-make-word'COMMON
+& can-make-word'SQUAD
+& can-make-word'CONFUSE
+);

Task/ABC-Problem/C++/abc-problem.cpp

@@ -0,0 +1,37 @@
+#include <iostream>
+#include <vector>
+#include <string>
+#include <set>
+#include <cctype>
+
+
+typedef std::pair<char,char> item_t;
+typedef std::vector<item_t> list_t;
+
+bool can_make_word(const std::string& w, const list_t& vals) {
+    std::set<uint32_t> used;
+    while (used.size() < w.size()) {
+        const char c = toupper(w[used.size()]);
+        uint32_t x = used.size();
+        for (uint32_t i = 0, ii = vals.size(); i < ii; ++i) {
+            if (used.find(i) == used.end()) {
+                if (toupper(vals[i].first) == c || toupper(vals[i].second) == c) {
+                    used.insert(i);
+                    break;
+                }
+            }
+        }
+        if (x == used.size()) break;
+    }
+    return used.size() == w.size();
+}
+
+
+int main() {
+    list_t vals{ {'B','O'}, {'X','K'}, {'D','Q'}, {'C','P'}, {'N','A'}, {'G','T'}, {'R','E'}, {'T','G'}, {'Q','D'}, {'F','S'}, {'J','W'}, {'H','U'}, {'V','I'}, {'A','N'}, {'O','B'}, {'E','R'}, {'F','S'}, {'L','Y'}, {'P','C'}, {'Z','M'} };
+    std::vector<std::string> words{"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"};
+    for (const std::string& w : words) {
+        std::cout << w << ": " << std::boolalpha << can_make_word(w,vals) << ".\n";
+    }
+
+}

Task/ABC-Problem/C-sharp/abc-problem.cs

@@ -0,0 +1,82 @@
+using System.Collections.Generic;
+using System.Linq;
+
+void Main()
+{
+	List<string> blocks =
+	new List<string>() { "bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs",
+		"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm" };
+	List<string> words = new List<string>() {
+		"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"};
+	
+	var solver = new ABC(blocks);
+	
+	foreach( var word in words)
+	{
+		Console.WriteLine("{0} :{1}", word, solver.CanMake(word));
+	}
+}
+
+class ABC
+{
+	readonly Dictionary<char, List<int>> _blockDict = new Dictionary<char, List<int>>();
+	bool[] _used;
+	int _nextBlock;
+
+	readonly List<string> _blocks;
+
+	private void AddBlockChar(char c)
+	{
+		if (!_blockDict.ContainsKey(c))
+		{
+			_blockDict[c] = new List<int>();
+		}
+		_blockDict[c].Add(_nextBlock);
+	}
+
+	private void AddBlock(string block)
+	{
+		AddBlockChar(block[0]);
+		AddBlockChar(block[1]);
+		_nextBlock++;
+	}
+
+	public ABC(List<string> blocks)
+	{
+		_blocks = blocks;
+		foreach (var block in blocks)
+		{
+			AddBlock(block);
+		}
+	}
+
+	public bool CanMake(string word)
+	{
+		word = word.ToLower();
+		if (word.Length > _blockDict.Count)
+		{
+			return false;
+		}
+		_used = new bool[_blocks.Count];
+		return TryMake(word);
+	}
+
+	public bool TryMake(string word)
+	{
+		if (word == string.Empty)
+		{
+			return true;
+		}
+		var blocks = _blockDict[word[0]].Where(b => !_used[b]);
+		foreach (var block in blocks)
+		{
+			_used[block] = true;
+			if (TryMake(word.Substring(1)))
+			{
+				return true;
+			}
+			_used[block] = false;
+		}
+		return false;
+	}
+}

Task/ABC-Problem/C/abc-problem.c

@@ -0,0 +1,41 @@
+#include <stdio.h>
+#include <ctype.h>
+
+int can_make_words(char **b, char *word)
+{
+	int i, ret = 0, c = toupper(*word);
+
+#define SWAP(a, b) if (a != b) { char * tmp = a; a = b; b = tmp; }
+
+	if (!c) return 1;
+	if (!b[0]) return 0;
+
+	for (i = 0; b[i] && !ret; i++) {
+		if (b[i][0] != c && b[i][1] != c) continue;
+		SWAP(b[i], b[0]);
+		ret = can_make_words(b + 1, word + 1);
+		SWAP(b[i], b[0]);
+	}
+
+	return ret;
+}
+
+int main(void)
+{
+	char* blocks[] = {
+		"BO", "XK", "DQ", "CP", "NA",
+		"GT", "RE", "TG", "QD", "FS",
+		"JW", "HU", "VI", "AN", "OB",
+		"ER", "FS", "LY", "PC", "ZM",
+		0 };
+
+	char *words[] = {
+		"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse", 0
+	};
+
+	char **w;
+	for (w = words; *w; w++)
+		printf("%s\t%d\n", *w, can_make_words(blocks, *w));
+
+	return 0;
+}

Task/ABC-Problem/Clojure/abc-problem.clj

@@ -0,0 +1,21 @@
+(def blocks
+  (-> "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM" (.split " ") vec))
+
+(defn omit
+  "return bs with (one instance of) b omitted"
+  [bs b]
+  (let [[before after] (split-with #(not= b %) bs)]
+    (concat before (rest after))))
+
+(defn abc
+  "return lazy sequence of solutions (i.e. block lists)"
+  [blocks [c & cs]]
+  (if-some c
+    (for [b blocks :when (some #(= c %) b)
+          bs (abc (omit blocks b) cs)]
+      (cons b bs))
+    [[]]))
+
+
+(doseq [word ["A" "BARK" "Book" "treat" "COMMON" "SQUAD" "CONFUSE"]]
+  (->> word .toUpperCase (abc blocks) first (printf "%s: %b\n" word)))

Task/ABC-Problem/CoffeeScript/abc-problem.coffee

@@ -0,0 +1,15 @@
+canMakeWord = (word="") ->
+    # Create a shallow clone of the master blockList
+    blocks = blockList.slice 0
+    # Check if blocks contains letter
+    checkBlocks = (letter) ->
+        # Loop through every remaining block
+        for block, idx in blocks
+            # If letter is in block, blocks.splice will return an array, which will evaluate as true
+            return blocks.splice idx, 1 if letter.toUpperCase() in block
+        return false
+    # Return true if there are no falsy values
+    return false not in (checkBlocks letter for letter in word)
+
+# Expect true, true, false, true, false, true, true, true
+console.log (canMakeWord word for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"])

Task/ABC-Problem/Common-Lisp/abc-problem.lisp

@@ -0,0 +1,14 @@
+(defun word-possible-p (word blocks)
+  (cond
+    ((= (length word) 0) t)
+    ((null blocks) nil)
+    (t (let*
+         ((c (aref word 0))
+          (bs (remove-if-not #'(lambda (b)
+                                 (find c b :test #'char-equal))
+                             blocks)))
+         (some #'identity
+               (loop for b in bs
+                     collect (word-possible-p
+                               (subseq word 1)
+                               (remove b blocks))))))))

Task/ABC-Problem/D/abc-problem-1.d

@@ -0,0 +1,22 @@
+import std.stdio, std.algorithm, std.string;
+
+bool canMakeWord(in string word, in string[] blocks) pure /*nothrow*/ @safe {
+    auto bs = blocks.dup;
+    outer: foreach (immutable ch; word.toUpper) {
+        foreach (immutable block; bs)
+            if (block.canFind(ch)) {
+                bs = bs.remove(bs.countUntil(block));
+                continue outer;
+            }
+        return false;
+    }
+    return true;
+}
+
+void main() @safe {
+    immutable blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI
+                        AN OB ER FS LY PC ZM".split;
+
+    foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
+        writefln(`"%s" %s`, word, canMakeWord(word, blocks));
+}

Task/ABC-Problem/D/abc-problem-2.d

@@ -0,0 +1,39 @@
+import std.ascii, core.stdc.stdlib;
+
+bool canMakeWord(in string word, in string[] blocks) nothrow @nogc
+in {
+    foreach (immutable char ch; word)
+        assert(ch.isASCII);
+    foreach (const block; blocks)
+        assert(block.length == 2 && block[0].isASCII && block[1].isASCII);
+} body {
+    auto ptr = cast(string*)alloca(blocks.length * string.sizeof);
+    if (ptr == null)
+        exit(1);
+    auto blocks2 = ptr[0 .. blocks.length];
+    blocks2[] = blocks[];
+
+    outer: foreach (immutable i; 0 .. word.length) {
+        immutable ch = word[i].toUpper;
+        foreach (immutable j; 0 .. blocks2.length) {
+            if (blocks2[j][0] == ch || blocks2[j][1] == ch) {
+                if (blocks2.length > 1)
+                    blocks2[j] = blocks2[$ - 1];
+                blocks2 = blocks2[0 .. $ - 1];
+                continue outer;
+            }
+        }
+        return false;
+    }
+    return true;
+}
+
+void main() {
+    import std.stdio, std.string;
+
+    immutable blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI
+                        AN OB ER FS LY PC ZM".split;
+
+    foreach (word; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
+        writefln(`"%s" %s`, word, canMakeWord(word, blocks));
+}

Task/ABC-Problem/D/abc-problem-3.d

@@ -0,0 +1,38 @@
+import std.stdio, std.ascii, std.algorithm, std.array;
+
+alias Block = char[2];
+
+// Modifies the order of the given blocks.
+bool canMakeWord(Block[] blocks, in string word) pure nothrow
+in {
+    assert(blocks.all!(w => w[].all!isAlpha));
+    assert(word.all!isAlpha);
+} body {
+    if (word.empty)
+        return true;
+
+    immutable c = word[0].toUpper;
+    foreach (ref b; blocks) {
+        if (b[0].toUpper != c && b[1].toUpper != c)
+            continue;
+        blocks[0].swap(b);
+        if (blocks[1 .. $].canMakeWord(word[1 .. $]))
+            return true;
+        blocks[0].swap(b);
+    }
+
+    return false;
+}
+
+void main() {
+    enum Block[] blocks = "BO XK DQ CP NA GT RE TG QD FS
+                           JW HU VI AN OB ER FS LY PC ZM".split;
+
+    foreach (w; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
+        writefln(`"%s" %s`, w, blocks.canMakeWord(w));
+
+    // Extra test.
+    Block[] blocks2 = ["AB", "AB", "AC", "AC"];
+    immutable word = "abba";
+    writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
+}

Task/ABC-Problem/D/abc-problem-4.d

@@ -0,0 +1,42 @@
+import std.stdio, std.ascii, std.algorithm, std.array, std.range;
+
+alias Block = char[2];
+
+bool canMakeWord(immutable Block[] blocks, in string word) pure nothrow
+in {
+    assert(blocks.all!(w => w[].all!isAlpha));
+    assert(word.all!isAlpha);
+} body {
+    bool inner(size_t[] indexes, in string w) pure nothrow {
+        if (w.empty)
+            return true;
+
+        immutable c = w[0].toUpper;
+        foreach (ref idx; indexes) {
+            if (blocks[idx][0].toUpper != c &&
+                blocks[idx][1].toUpper != c)
+                continue;
+            indexes[0].swap(idx);
+            if (inner(indexes[1 .. $], w[1 .. $]))
+                return true;
+            indexes[0].swap(idx);
+        }
+
+        return false;
+    }
+
+    return inner(blocks.length.iota.array, word);
+}
+
+void main() {
+    enum Block[] blocks = "BO XK DQ CP NA GT RE TG QD FS
+                           JW HU VI AN OB ER FS LY PC ZM".split;
+
+    foreach (w; "" ~ "A BARK BoOK TrEAT COmMoN SQUAD conFUsE".split)
+        writefln(`"%s" %s`, w, blocks.canMakeWord(w));
+
+    // Extra test.
+    immutable Block[] blocks2 = ["AB", "AB", "AC", "AC"];
+    immutable word = "abba";
+    writefln(`"%s" %s`, word, blocks2.canMakeWord(word));
+}

Task/ABC-Problem/Delphi/abc-problem.delphi

@@ -0,0 +1,63 @@
+program ABC;
+{$APPTYPE CONSOLE}
+
+uses SysUtils;
+
+type
+  TBlock = set of char;
+
+const
+  TheBlocks : array [0..19] of TBlock =
+  (
+    [ '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' ]
+  );
+
+function SolveABC(Target : string; Blocks : array of TBlock) : boolean;
+var
+  iChr : integer;
+  Used : array [0..19] of boolean;
+
+  function FindUnused(TargetChr : char) : boolean;  // Nested routine
+  var
+    iBlock : integer;
+  begin
+    Result := FALSE;
+    for iBlock := low(Blocks) to high(Blocks) do
+      if (not Used[iBlock]) and ( TargetChr in Blocks[iBlock] ) then
+      begin
+        Result := TRUE;
+        Used[iBlock] := TRUE;
+        Break;
+      end;
+  end;
+
+begin
+  FillChar(Used, sizeof(Used), ord(FALSE));
+  Result := TRUE;
+  iChr := 1;
+  while Result and (iChr <= length(Target)) do
+    if FindUnused(Target[iChr]) then inc(iChr)
+                                else Result := FALSE;
+end;
+
+procedure CheckABC(Target : string);
+begin
+  if SolveABC(uppercase(Target), TheBlocks) then
+    writeln('Can make ' + Target)
+  else
+    writeln('Can NOT make ' + Target);
+end;
+
+begin
+  CheckABC('A');
+  CheckABC('BARK');
+  CheckABC('BOOK');
+  CheckABC('TREAT');
+  CheckABC('COMMON');
+  CheckABC('SQUAD');
+  CheckABC('CONFUSE');
+  readln;
+end.

Task/ABC-Problem/Erlang/abc-problem.erl

@@ -0,0 +1,16 @@
+-module(abc).
+-export([can_make_word/1, can_make_word/2, blocks/0]).
+
+blocks() -> ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
+             "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"].
+
+can_make_word(Word) -> can_make_word(Word, blocks()).
+can_make_word(Word, Avail) -> can_make_word(string:to_upper(Word), Avail, []).
+can_make_word([], _, _) -> true;
+can_make_word(_, [], _) -> false;
+can_make_word([L|Tail], [B|Rest], Tried) ->
+  (lists:member(L,B) andalso can_make_word(Tail, lists:append(Rest, Tried),[]))
+  orelse can_make_word([L|Tail], Rest, [B|Tried]).
+
+main(_) -> lists:map(fun(W) -> io:fwrite("~s: ~s~n", [W, can_make_word(W)]) end,
+                     ["A","Bark","Book","Treat","Common","Squad","Confuse"]).

Task/ABC-Problem/Euphoria/abc-problem.euphoria

@@ -0,0 +1,35 @@
+include std/text.e
+
+sequence 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'}}
+sequence words = {"A","BarK","BOOK","TrEaT","COMMON","SQUAD","CONFUSE"}
+
+sequence current_word
+sequence temp
+integer matches
+
+for i = 1 to length(words) do
+	current_word = upper(words[i])
+	temp = blocks
+	matches = 0
+	for j = 1 to length(current_word) do
+		for k = 1 to length(temp) do
+			if find(current_word[j],temp[k]) then
+				temp = remove(temp,k)
+				matches += 1
+				exit
+			end if
+		end for
+		if length(current_word) = matches then
+			printf(1,"%s: TRUE\n",{words[i]})
+			exit
+		end if
+	end for
+	if length(current_word) != matches then
+		printf(1,"%s: FALSE\n",{words[i]})
+	end if
+end for
+
+if getc(0) then end if

Task/ABC-Problem/FBSL/abc-problem.fbsl

@@ -0,0 +1,44 @@
+#APPTYPE CONSOLE
+SUB MAIN()
+	BlockCheck("A")
+	BlockCheck("BARK")
+	BlockCheck("BooK")
+	BlockCheck("TrEaT")
+	BlockCheck("comMON")
+	BlockCheck("sQuAd")
+	BlockCheck("Confuse")
+	pause
+END SUB
+
+FUNCTION BlockCheck(str)
+	print str " " iif( Blockable( str ), "can", "cannot" ) " be spelled with blocks."
+END FUNCTION
+
+FUNCTION Blockable(str AS STRING)
+	DIM blocks AS STRING = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
+	DIM C AS STRING = ""
+	DIM POS AS INTEGER = 0
+	
+	FOR DIM I = 1 TO LEN(str)
+		C = str{i}
+		POS = INSTR(BLOCKS, C, 0, 1) 'case insensitive
+		IF POS > 0 THEN
+			'if the pos is odd, it's the first of the pair
+			IF POS MOD 2 = 1 THEN
+				'so clear the first and the second
+				poke(@blocks + pos - 1," ")
+				poke(@blocks + pos," ")
+			'otherwise, it's the last of the pair	
+			ELSE
+				'clear the second and the first
+				poke(@blocks + pos - 1," ")
+				poke(@blocks + pos - 2," ")
+			END IF
+		ELSE
+		'not found, so can't be spelled
+		RETURN FALSE
+		END IF
+	NEXT
+	'got thru to here, so can be spelled
+	RETURN TRUE
+END FUNCTION

Task/ABC-Problem/Fortran/abc-problem.f

@@ -0,0 +1,70 @@
+!-*- mode: compilation; default-directory: "/tmp/" -*-
+!Compilation started at Thu Jun  5 01:52:03
+!
+!make f && for a in '' a bark book treat common squad confuse ; do echo $a | ./f ; done
+!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none -g f.f08 -o f
+! T
+! T  A                    NA
+! T  BARK                 BO NA RE XK
+! F  BOOK                 OB BO -- --
+! T  TREAT                GT RE ER NA TG
+! F  COMMON               PC OB ZM -- -- --
+! T  SQUAD                FS DQ HU NA QD
+! T  CONFUSE              CP BO NA FS HU FS RE
+!
+!Compilation finished at Thu Jun  5 01:52:03
+
+program abc
+  implicit none
+  integer, parameter :: nblocks = 20
+  character(len=nblocks) :: goal
+  integer, dimension(nblocks) :: solution
+  character(len=2), dimension(0:nblocks) :: blocks_copy, blocks = &
+       &(/'--','BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW','HU','VI','AN','OB','ER','FS','LY','PC','ZM'/)
+  logical :: valid
+  integer :: i, iostat
+  read(5,*,iostat=iostat) goal
+  if (iostat .ne. 0) goal = ''
+  call ucase(goal)
+  solution = 0
+  blocks_copy = blocks
+  valid = assign_block(goal(1:len_trim(goal)), blocks, solution, 1)
+  write(6,*) valid, ' '//goal, (' '//blocks_copy(solution(i)), i=1,len_trim(goal))
+
+contains
+
+  recursive function assign_block(goal, blocks, solution, n) result(valid)
+    implicit none
+    logical :: valid
+    character(len=*), intent(in) :: goal
+    character(len=2), dimension(0:), intent(inout) :: blocks
+    integer, dimension(:), intent(out) :: solution
+    integer, intent(in) :: n
+    integer :: i
+    character(len=2) :: backing_store
+    valid = .true.
+    if (len(goal)+1 .eq. n) return
+    do i=1, size(blocks)
+       if (index(blocks(i),goal(n:n)) .ne. 0) then
+          backing_store = blocks(i)
+          blocks(i) = ''
+          solution(n) = i
+          if (assign_block(goal, blocks, solution, n+1)) return
+          blocks(i) = backing_store
+       end if
+    end do
+    valid = .false.
+    return
+  end function assign_block
+
+  subroutine ucase(a)
+    implicit none
+    character(len=*), intent(inout) :: a
+    integer :: i, j
+    do i = 1, len_trim(a)
+       j = index('abcdefghijklmnopqrstuvwxyz',a(i:i))
+       if (j .ne. 0) a(i:i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(j:j)
+    end do
+  end subroutine ucase
+
+end program abc

Task/ABC-Problem/Go/abc-problem.go

@@ -0,0 +1,39 @@
+package main
+
+import (
+	"fmt"
+	"strings"
+)
+
+func newSpeller(blocks string) func(string) bool {
+	bl := strings.Fields(blocks)
+	return func(word string) bool {
+		return r(word, bl)
+	}
+}
+
+func r(word string, bl []string) bool {
+	if word == "" {
+		return true
+	}
+	c := word[0] | 32
+	for i, b := range bl {
+		if c == b[0]|32 || c == b[1]|32 {
+			bl[i], bl[0] = bl[0], b
+			if r(word[1:], bl[1:]) == true {
+				return true
+			}
+			bl[i], bl[0] = bl[0], bl[i]
+		}
+	}
+	return false
+}
+
+func main() {
+	sp := newSpeller(
+		"BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM")
+	for _, word := range []string{
+		"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"} {
+		fmt.Println(word, sp(word))
+	}
+}

Task/ABC-Problem/Groovy/abc-problem-1.groovy

@@ -0,0 +1,12 @@
+class ABCSolver {
+    def blocks
+
+    ABCSolver(blocks = []) { this.blocks = blocks }
+
+    boolean canMakeWord(rawWord) {
+        if (rawWord == '' || rawWord == null) { return true; }
+        def word = rawWord.toUpperCase()
+        def blocksLeft = [] + blocks
+        word.every { letter -> blocksLeft.remove(blocksLeft.find { block -> block.contains(letter) }) }
+    }
+}

Task/ABC-Problem/Groovy/abc-problem-2.groovy

@@ -0,0 +1,6 @@
+def a = new ABCSolver(["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
+                      "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"])
+
+['', 'A', 'BARK', 'book', 'treat', 'COMMON', 'SQuAd', 'CONFUSE'].each {
+    println "'${it}': ${a.canMakeWord(it)}"
+}

Task/ABC-Problem/Haskell/abc-problem.hs

@@ -0,0 +1,15 @@
+import Data.List (delete)
+import Data.Char (toUpper)
+
+-- returns list of all solutions, each solution being a list of blocks
+abc :: (Eq a) => [[a]] -> [a] -> [[[a]]]
+abc _ [] = [[]]
+abc blocks (c:cs) = [b:ans | b <- blocks, c `elem` b,
+                             ans <- abc (delete b blocks) cs]
+
+blocks = ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
+          "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"]
+
+main :: IO ()
+main = mapM_ (\w -> print (w, not . null $ abc blocks (map toUpper w)))
+         ["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]

Task/ABC-Problem/Icon/abc-problem.icon

@@ -0,0 +1,24 @@
+procedure main(A)
+    blocks := ["bo","xk","dq","cp","na","gt","re","tg","qd","fs",
+               "jw","hu","vi","an","ob","er","fs","ly","pc","zm",&null]
+    every write("\"",word := !A,"\" ",checkSpell(map(word),blocks)," with blocks.")
+end
+
+procedure checkSpell(w,blocks)
+    blks := copy(blocks)
+    w ? return if canMakeWord(blks) then "can be spelled"
+                                    else "can not be spelled"
+end
+
+procedure canMakeWord(blks)
+    c := move(1) | return
+    if /blks[1] then fail
+    every i := 1 to *blks do {
+        if /blks[i] then (move(-1),fail)
+        if c == !blks[i] then {
+            blks[1] :=: blks[i]
+            if canMakeWord(blks[2:0]) then return
+            blks[1] :=: blks[i]
+            }
+        }
+end

Task/ABC-Problem/J/abc-problem-1.j

@@ -0,0 +1,11 @@
+reduce=: verb define
+  'rows cols'=. i.&.> $y
+  for_c. cols do.
+    r=. 1 i.~ c {"1 y             NB. row idx of first 1 in col
+    if. r = #rows do. continue. end.
+    y=. 0 (<((r+1)}.rows);c) } y  NB. zero rest of col
+    y=. 0 (<(r;(c+1)}.cols)) } y  NB. zero rest of row
+  end.
+)
+
+abc=: *./@(+./)@reduce@(e."1~ ,)&toupper :: 0:

Task/ABC-Problem/J/abc-problem-2.j

@@ -0,0 +1,14 @@
+   Blocks=:  ];._2 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM '
+   ExampleWords=: <;._2 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
+
+   Blocks&abc &> ExampleWords
+1 1 0 1 0 1 1
+   require 'format/printf'
+   '%10s  %s' printf (dquote ; 'FT' {~ Blocks&abc) &> ExampleWords
+       "A"  T
+    "BaRK"  T
+    "BOoK"  F
+   "tREaT"  T
+  "COmMOn"  F
+   "SqUAD"  T
+ "CoNfuSE"  T

Task/ABC-Problem/J/abc-problem-3.j

@@ -0,0 +1,3 @@
+delElem=: {~<@<@<
+uppc=:(-32*96&<*.123&>)&.(3&u:)
+reduc=: ] delElem  1 i.~e."0 1

Task/ABC-Problem/J/abc-problem-4.j

@@ -0,0 +1,10 @@
+Blocks=:  >;:'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM '
+ExampleWords=: ;: 'A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE '
+
+canform=:4 :0
+  word=: toupper y
+  need=: #/.~ word,word
+  relevant=: (x +./@e."1 word) # x
+  candidates=: word,"1>,{{relevant
+  +./(((#need){. #/.~)"1 candidates) */ .>:need
+)

Task/ABC-Problem/J/abc-problem-5.j

@@ -0,0 +1,14 @@
+   Blocks canform 0{::ExampleWords
+1
+   Blocks canform 1{::ExampleWords
+1
+   Blocks canform 2{::ExampleWords
+0
+   Blocks canform 3{::ExampleWords
+1
+   Blocks canform 4{::ExampleWords
+0
+   Blocks canform 5{::ExampleWords
+1
+   Blocks canform 6{::ExampleWords
+1

Task/ABC-Problem/Java/abc-problem.java

@@ -0,0 +1,44 @@
+import java.util.Arrays;
+
+public class ABC{
+	private static void swap(int i, int j, Object... arr){
+		Object tmp = arr[i];
+		arr[i] = arr[j];
+		arr[j] = tmp;
+	}
+	
+	public static boolean canMakeWord(String word, String... blocks) {
+	    if(word.length() == 0)
+	        return true;
+	
+	    char c = Character.toUpperCase(word.charAt(0));
+	    for(int i = 0; i < blocks.length; i++) {
+	    	String b = blocks[i];
+	        if(Character.toUpperCase(b.charAt(0)) != c && Character.toUpperCase(b.charAt(1)) != c)
+	            continue;
+	        swap(0, i, blocks);
+	        if(canMakeWord(word.substring(1), Arrays.copyOfRange(blocks, 1, blocks.length)))
+	            return true;
+	        swap(0, i, blocks);
+	    }
+	
+	    return false;
+	}
+	
+	public static void main(String[] args){
+		String[] blocks = {"BO", "XK", "DQ", "CP", "NA",
+				"GT", "RE", "TG", "QD", "FS",
+				"JW", "HU", "VI", "AN", "OB",
+				"ER", "FS", "LY", "PC", "ZM"};
+
+		System.out.println("\"\": " + canMakeWord("", blocks));
+		System.out.println("A: " + canMakeWord("A", blocks));
+		System.out.println("BARK: " + canMakeWord("BARK", blocks));
+		System.out.println("book: " + canMakeWord("book", blocks));
+		System.out.println("treat: " + canMakeWord("treat", blocks));
+		System.out.println("COMMON: " + canMakeWord("COMMON", blocks));
+		System.out.println("SQuAd: " + canMakeWord("SQuAd", blocks));
+		System.out.println("CONFUSE: " + canMakeWord("CONFUSE", blocks));
+		
+	}
+}

Task/ABC-Problem/JavaScript/abc-problem.js

@@ -0,0 +1,32 @@
+let characters = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
+let blocks = characters.split(" ").map(pair => pair.split(""));
+
+function isWordPossible(word) {
+  var letters = [...word.toUpperCase()];
+  var length = letters.length;
+  var copy = new Set(blocks);
+
+  for (let letter of letters) {
+    for (let block of copy) {
+      let index = block.indexOf(letter);
+
+      if (index !== -1) {
+        length--;
+        copy.delete(block);
+        break;
+      }
+    }
+
+  }
+  return !length;
+}
+
+[
+  "A",
+  "BARK",
+  "BOOK",
+  "TREAT",
+  "COMMON",
+  "SQUAD",
+  "CONFUSE"
+].forEach(word => console.log(`${word}: ${isWordPossible(word)}`));

Task/ABC-Problem/Julia/abc-problem.julia

@@ -0,0 +1,9 @@
+function abc (str, list)
+  isempty(str) && return true
+  for i = 1:length(list)
+    str[end] in list[i] &&
+    any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
+    return true
+  end
+  false
+end

Task/ABC-Problem/Logo/abc-problem.logo

@@ -0,0 +1,21 @@
+make "blocks [[B O] [X K] [D Q] [C P] [N A] [G T] [R E] [T G] [Q D] [F S]
+              [J W] [H U] [V I] [A N] [O B] [E R] [F S] [L Y] [P C] [Z M]]
+
+to can_make? :word [:avail :blocks]
+  if empty? :word [output "true]
+  local "letter make "letter first :word
+  foreach :avail [
+    local "i     make "i     #
+    local "block make "block ?
+    if member? :letter :block [
+      if (can_make? bf :word filter [notequal? # :i] :avail) [output "true]
+    ]
+  ]
+  output "false
+end
+
+foreach [A BARK BOOK TREAT COMMON SQUAD CONFUSE] [
+  print sentence word ? ": can_make? ?
+]
+
+bye

Task/ABC-Problem/MATLAB/abc-problem.m

@@ -0,0 +1,26 @@
+function testABC
+    combos = ['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'};
+    for k = 1:length(words)
+        possible = canMakeWord(words{k}, combos);
+        fprintf('Can%s make word %s.\n', char(~possible.*'NOT'), words{k})
+    end
+end
+
+function isPossible = canMakeWord(word, combos)
+    word = lower(word);
+    combos = lower(combos);
+    isPossible = true;
+    k = 1;
+    while isPossible && k <= length(word)
+        [r, c] = find(combos == word(k), 1);
+        if ~isempty(r)
+            combos(r, :) = '';
+        else
+            isPossible = false;
+        end
+        k = k+1;
+    end
+end

Task/ABC-Problem/MAXScript/abc-problem-1.max

@@ -0,0 +1,98 @@
+-- This is the blocks array
+global GlobalBlocks = #("BO","XK","DQ","CP","NA", \
+			"GT","RE","TG","QD","FS", \
+			"JW","HU","VI","AN","OB", \
+			"ER","FS","LY","PC","ZM")
+
+-- This function returns true if "_str" is part of "_word", false otherwise
+fn occurs _str _word =
+(
+	if _str != undefined and _word != undefined then
+	(
+	matchpattern _word pattern:("*"+_str+"*")
+	) else return false
+)
+
+-- This is the main function
+fn isWordPossible word blocks: = -- blocks is a keyword argument
+(
+	word = toupper word -- convert the string to upper case, to make it case insensitive
+	if blocks == unsupplied do blocks = GlobalBlocks
+	-- if blocks (keyword argument) is unsupplied, use the global blocks array (this is for recursion)
+	
+	blocks = deepcopy blocks
+
+	local pos = 1 -- start at the beginning of the word
+	local solvedLetters = #() -- this array stores the indices of solved letters
+	
+	while pos <= word.count do -- loop through every character in the word
+	(
+		local possibleBlocks = #() -- this array stores the blocks which can be used to make that letter
+		for b = 1 to Blocks.count do -- this loop finds all the possible blocks that can be used to make that letter
+		(
+			if occurs word[pos] blocks[b] do
+			(
+				appendifunique possibleBlocks b
+			)
+		)
+		if possibleBlocks.count > 0 then -- if it found any blocks
+		(
+			if possibleBlocks.count == 1 then -- if it found one block, then continue
+			(
+				appendifunique solvedLetters pos
+				deleteitem blocks possibleblocks[1]
+				pos += 1
+			)
+			else -- if it found more than one
+			(
+				for b = 1 to possibleBlocks.count do -- loop through every possible block
+				(
+					local possibleBlock = blocks[possibleBlocks[b]]
+					local blockFirstLetter = possibleBlock[1]
+					local blockSecondLetter = possibleBlock[2]
+					local matchingLetter = if blockFirstLetter == word[pos] then 1 else 2
+					-- ^ this is the index of the matching letter on the block
+					
+					local notMatchingIndex = if matchingLetter == 1 then 2 else 1
+					local notMatchingLetter = possibleBlock[notMatchingIndex]
+					-- ^ this is the other letter on the block
+					
+					if occurs notMatchingLetter (substring word (pos+1) -1) then
+					( -- if the other letter occurs in the rest of the word
+						local removedBlocks = deepcopy blocks -- copy the current blocks array
+						deleteitem removedBlocks possibleBlocks[b] -- remove the item from the copied array
+						
+						-- recursively check if the word is possible if that block is taken away from the array:
+						if (isWordPossible (substring word (pos+1) -1) blocks:removedBlocks) then
+						( -- if it is, then remove the block and move to next character
+							appendifunique solvedLetters pos
+							deleteitem blocks possibleblocks[1]
+							pos += 1
+							exit
+						)
+						else
+						( -- if it isn't and it looped through every possible block, then the word is not possible
+							if b == possibleBlocks.count do return false
+						)
+					)
+					else
+					( -- if the other letter on this block doesn't occur in the rest of the word, then the letter is solved, continue
+							appendifunique solvedLetters pos
+							deleteitem blocks possibleblocks[b]
+							pos += 1
+							exit
+					)
+				)
+			)
+		) else return false -- if it didn't find any blocks, then return false
+	)
+
+	makeuniquearray solvedLetters -- make sure there are no duplicates in the solved array
+	if solvedLetters.count != word.count then return false -- if number of solved letters is not equal to word length
+		else
+			( -- this checks if all the solved letters are the same as the word
+				check = ""
+				for bit in solvedLetters do append check word[bit]
+				if check == word then return true else return false
+			)
+)

Task/ABC-Problem/MAXScript/abc-problem-2.max

@@ -0,0 +1,14 @@
+iswordpossible "a"
+true
+iswordpossible "bark"
+true
+iswordpossible "book"
+false
+iswordpossible "treat"
+true
+iswordpossible "common"
+false
+iswordpossible "squad"
+true
+iswordpossible "confuse"
+true

Task/ABC-Problem/MAXScript/abc-problem-3.max

@@ -0,0 +1,30 @@
+fn isWordPossible2 word =
+(
+	Blocks = #("BO","XK","DQ","CP","NA", \
+			   "GT","RE","TG","QD","FS", \
+			   "JW","HU","VI","AN","OB", \
+			   "ER","FS","LY","PC","ZM")
+        word = toupper word
+	local pos = 1
+	local solvedLetters = #()
+	while pos <= word.count do
+	(
+		for i = 1 to blocks.count do
+		(
+			if (matchpattern blocks[i] pattern:("*"+word[pos]+"*")) then
+				(
+					deleteitem blocks i
+					appendifunique solvedLetters pos
+					pos +=1
+					exit
+				)
+			else if i == blocks.count do return false
+		)
+	)
+	if solvedLetters.count == word.count then
+	(
+		local check = ""
+		for bit in solvedLetters do append check word[bit]
+		if check == word then return true else return false
+	) else return false
+)

Task/ABC-Problem/MAXScript/abc-problem-4.max

@@ -0,0 +1,4 @@
+iswordpossible "water"
+true
+iswordpossible2 "water"
+false

Task/ABC-Problem/Mathematica/abc-problem.math

@@ -0,0 +1,12 @@
+blocks=Partition[Characters[ToLowerCase["BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"]],2];
+ClearAll[DoStep,ABCBlockQ]
+DoStep[chars_List,blcks_List,chosen_List]:=Module[{opts},
+ If[chars=!={},
+  opts=Select[blcks,MemberQ[#,First[chars]]&];
+  {Rest[chars],DeleteCases[blcks,#,1,1],Append[chosen,#]}&/@opts
+ ,
+  {{chars,blcks,chosen}}
+ ]
+]
+DoStep[opts_List]:=Flatten[DoStep@@@opts,1]
+ABCBlockQ[str_String]:=(FixedPoint[DoStep,{{Characters[ToLowerCase[str]],blocks,{}}}]=!={})

Task/ABC-Problem/OCaml/abc-problem.ocaml

@@ -0,0 +1,40 @@
+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 (succ i) rem_blocks
+  in
+  aux 0 blocks
+
+let test label f (word, should) =
+  Printf.printf "- %s %S = %B  (should: %B)\n" 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;
+  ]

Task/ABC-Problem/Oberon-2/abc-problem.oberon-2

@@ -0,0 +1,83 @@
+MODULE ABCBlocks;
+IMPORT
+  Object,
+  Out;
+
+VAR
+  blocks: ARRAY 20 OF STRING;
+
+    PROCEDURE CanMakeWord(w: STRING): BOOLEAN;
+    VAR
+      used: ARRAY 20 OF LONGINT;
+      wChars: Object.CharsLatin1;
+      i,j: LONGINT;
+
+      PROCEDURE IsUsed(i: LONGINT): BOOLEAN;
+      VAR
+        b: LONGINT;
+      BEGIN
+        b := 0;
+        WHILE (b < LEN(used) - 1) & (used[b] # -1) DO
+          IF used[b] = i THEN RETURN TRUE END;
+          INC(b)
+        END;
+        RETURN FALSE
+      END IsUsed;
+
+      PROCEDURE GetBlockFor(blocks: ARRAY OF STRING; c: CHAR): LONGINT;
+      VAR
+        i: LONGINT;
+      BEGIN
+        i := 0;
+        WHILE (i < LEN(blocks)) DO
+          IF (blocks[i].IndexOf(c,0) >= 0) & (~IsUsed(i)) THEN RETURN i END;
+          INC(i)
+        END;
+
+        RETURN -1;
+      END GetBlockFor;
+
+    BEGIN
+      FOR i := 0 TO LEN(used) - 1 DO used[i] := -1 END;
+      wChars := w(Object.String8).CharsLatin1();
+
+      i := 0;
+      WHILE (i < LEN(wChars^) - 1) DO
+        j := GetBlockFor(blocks,CAP(wChars[i]));
+        IF j < 0 THEN RETURN FALSE END;
+        used[i] := j;
+        INC(i)
+      END;
+      RETURN TRUE
+    END CanMakeWord;
+
+BEGIN
+  blocks[0] := "BO";
+  blocks[1] := "XK";
+  blocks[2] := "DQ";
+  blocks[3] := "CP";
+  blocks[4] := "NA";
+  blocks[5] := "GT";
+  blocks[6] := "RE";
+  blocks[7] := "TG";
+  blocks[8] := "QD";
+  blocks[9] := "FS";
+  blocks[10] := "JW";
+  blocks[11] := "HU";
+  blocks[12] := "VI";
+  blocks[13] := "AN";
+  blocks[14] := "OB";
+  blocks[15] := "ER";
+  blocks[16] := "FS";
+  blocks[17] := "LY";
+  blocks[18] := "PC";
+  blocks[19] := "ZM";
+
+  Out.String("A: ");Out.Bool(CanMakeWord("A"));Out.Ln;
+  Out.String("BARK: ");Out.Bool(CanMakeWord("BARK"));Out.Ln;
+  Out.String("BOOK: ");Out.Bool(CanMakeWord("BOOK"));Out.Ln;
+  Out.String("TREAT: ");Out.Bool(CanMakeWord("TREAT"));Out.Ln;
+  Out.String("COMMON: ");Out.Bool(CanMakeWord("COMMON"));Out.Ln;
+  Out.String("SQAD: ");Out.Bool(CanMakeWord("SQUAD"));Out.Ln;
+  Out.String("confuse: ");Out.Bool(CanMakeWord("confuse"));Out.Ln;
+END ABCBlocks.

Task/ABC-Problem/PHP/abc-problem.php

@@ -0,0 +1,29 @@
+<?php
+$words = array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse");
+
+function canMakeWord($word) {
+    $word = strtoupper($word);
+    $blocks = array(
+            "BO", "XK", "DQ", "CP", "NA",
+            "GT", "RE", "TG", "QD", "FS",
+            "JW", "HU", "VI", "AN", "OB",
+            "ER", "FS", "LY", "PC", "ZM",
+    );
+
+    foreach (str_split($word) as $char) {
+        foreach ($blocks as $k => $block) {
+            if (strpos($block, $char) !== FALSE) {
+                unset($blocks[$k]);
+                continue(2);
+            }
+        }
+        return false;
+    }
+    return true;
+}
+
+foreach ($words as $word) {
+    echo $word.': ';
+    echo canMakeWord($word) ? "True" : "False";
+    echo "\r\n";
+}

Task/ABC-Problem/PL-I/abc-problem-1.pli

@@ -0,0 +1,25 @@
+ABC: procedure options (main);   /* 12 January 2014 */
+
+   declare word character (20) varying, blocks character (200) varying initial
+      ('((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))');
+   declare tblocks character (200) varying;
+   declare (true value ('1'b), false value ('0'b), flag) bit (1);
+   declare ch character (1);
+   declare (i, k) fixed binary;
+
+   do word = 'A', 'BARK', 'BOOK', 'TREAT', 'COMMON', 'SQuAd', 'CONFUSE';
+      flag = true;
+      tblocks = blocks;
+      do i = 1 to length(word);
+         ch = substr(word, i, 1);
+         k = index(tblocks, uppercase(ch));
+         if k = 0 then
+            flag = false;
+         else /* Found a block with the letter on it. */
+            substr(tblocks, k-1, 4) = '   '; /* Delete the block. */
+      end;
+      if flag then put skip list (word, 'true'); else put skip list (word, 'false');
+   end;
+
+end ABC;

Task/ABC-Problem/PL-I/abc-problem-2.pli

@@ -0,0 +1,121 @@
+*process source attributes xref or(!) options nest;
+ abc: Proc Options(main);
+ /* REXX --------------------------------------------------------------
+ * 10.01.2013 Walter Pachl  counts the number of possible ways
+ * translated from Rexx version 2
+ *-------------------------------------------------------------------*/
+
+ Dcl (ADDR,HBOUND,INDEX,LEFT,LENGTH,MAX,SUBSTR,TRANSLATE) builtin;
+ Dcl sysprint Print;
+ Dcl (i,j,k,m,mm,wi,wj,wlen,ways,lw) Bin Fixed(15);
+ Dcl blocks(20) Char(2)
+        Init('BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW',
+             'HU','VI','AN','OB','ER','FS','LY','PC','ZM');
+ Dcl blk Char(2);
+ Dcl words(8) Char(7) Var
+        Init('$','A','baRk','bOOk','trEat','coMMon','squaD','conFuse');
+ Dcl word     Char(7) Var;
+ Dcl c Char(1);
+ Dcl (show,cannot) Bit(1) Init('0'b);
+ Dcl poss(100,0:100) Pic'99';  poss=0;
+ Dcl s(20,100) char(100) Var;
+ Dcl str Char(100);
+ Dcl 1 *(30) Based(addr(str)),
+      2 strp Pic'99',
+      2 * Char(1);
+ Dcl ns(20) Bin Fixed(15) Init((20)0);
+ Dcl ol(100) Char(100) Var;
+ Dcl os      Char(100) Var;
+ wlen=0;
+ Dcl lower Char(26) Init('abcdefghijklmnopqrstuvwxyz');
+ Dcl upper Char(26) Init('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
+ Do wi=1 To hbound(words);
+   wlen=max(wlen,length(words(wi)));
+   End;
+ Do wi=1 To hbound(words);
+   word = translate(words(wi),upper,lower);
+   ways=0;
+   lw=length(word);
+   cannot='0'b;
+   poss=0;
+   ns=0;
+   ol='';
+ iloop:
+   Do i=1 To lw;                       /* loop over the characters   */
+     c=substr(word,i,1);               /* the current character      */
+     Do j=1 To hbound(blocks);         /* loop over blocks           */
+       blk=blocks(j);
+       If index(blk,c)>0 Then Do;  /* block can be used in this pos( */
+         poss(i,0)+=1;        /* number of possible blocks for pos i */
+         poss(i,poss(i,0))=j;
+         End;
+       End;
+     If poss(i,0)=0 Then Do;
+       Leave iloop;
+       End;
+     End;
+   If i>lw Then Do;                     /* no prohibitive character  */
+     ns=0;
+     Do j=1 To poss(1,0);       /* build possible strings for char 1 */
+       ns(1)+=1;;
+       s(1,j)=poss(1,j);
+       End;
+     Do m=2 To lw;        /* build possible strings for chars 1 to i */
+       mm=m-1;
+       Do j=1 To ns(mm);
+         Do k=1 To poss(m,0);
+           ns(m)+=1;
+           s(m,ns(m))=s(mm,j)!!' '!!poss(m,k);
+           End;
+         End;
+       End;
+     Do m=1 To ns(lw);
+       If valid(s(lw,m)) Then Do;
+         ways+=1;
+         str=s(lw,m);
+         Do k=1 To lw;
+           ol(ways)=ol(ways)!!blocks(strp(k))!!' ';
+           End;
+         End;
+       End;
+     End;
+ /*--------------------------------------------------------------------
+ * now show the result
+ *-------------------------------------------------------------------*/
+   os=left(''''!!word!!'''',wlen+2);
+   Select;
+     When(ways=0)
+       os=os!!' cannot be spelt.';
+     When(ways=1)
+       os=os!!' can be spelt.';
+     Otherwise
+       os=os!!' can be spelt in'!!ways!!' ways.';
+     End;
+   Put Skip List(os);
+   If show Then Do;
+     Do wj=1 To ways;
+       Put Edit('          '!!ol(wj))(Skip,a);
+       End;
+     End;
+   End;
+ Return;
+
+ valid: Procedure(list) Returns(bit(1));
+ /*--------------------------------------------------------------------
+ * Check if the same block is used more than once -> 0
+ * Else: the combination is valid
+ *-------------------------------------------------------------------*/
+ Dcl list Char(*) Var;
+ Dcl i Bin Fixed(15);
+ Dcl used(20) Bit(1);
+ str=list;
+ used='0'b;
+ Do i=1 To lw;
+   If used(strp(i)) Then
+     Return('0'b);
+   used(strp(i))='1'b;
+   End;
+ Return('1'b);
+ End;
+
+ End;

Task/ABC-Problem/Perl-6/abc-problem.pl6

@@ -0,0 +1,21 @@
+multi can-spell-word(Str $word, @blocks) {
+    my @regex = @blocks.map({ EVAL "/{.comb.join('|')}/" }).grep: { .ACCEPTS($word.uc) }
+    can-spell-word $word.uc.comb, @regex;
+}
+
+multi can-spell-word([$head,*@tail], @regex) {
+    for @regex -> $re {
+        if $head ~~ $re {
+            return True unless @tail;
+            return False if @regex == 1;
+            return True if can-spell-word @tail, @regex.grep: * !=== $re;
+        }
+    }
+    False;
+}
+
+my @b = <BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM>;
+
+for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
+    say "$_     &can-spell-word($_, @b)";
+}

Task/ABC-Problem/Perl/abc-problem-1.pl

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+
+sub can_make_word {
+    my ($word, @blocks) = @_;
+    $_ = uc join q(), sort split // for @blocks;
+    my %blocks;
+    $blocks{$_}++ for @blocks;
+    return _can_make_word(uc $word, %blocks)
+}
+
+
+sub _can_make_word {
+    my ($word, %blocks) = @_;
+    my $char = substr $word, 0, 1, q();
+
+    my @candidates = grep 0 <= index($_, $char), keys %blocks;
+    for my $candidate (@candidates) {
+        next if $blocks{$candidate} <= 0;
+        local $blocks{$candidate} = $blocks{$candidate} - 1;
+        return 1 if q() eq $word or _can_make_word($word, %blocks);
+    }
+    return
+}

Task/ABC-Problem/Perl/abc-problem-2.pl

@@ -0,0 +1,13 @@
+use Test::More tests => 8;
+
+my @blocks1 = qw(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM);
+is(can_make_word("A",       @blocks1), 1);
+is(can_make_word("BARK",    @blocks1), 1);
+is(can_make_word("BOOK",    @blocks1), undef);
+is(can_make_word("TREAT",   @blocks1), 1);
+is(can_make_word("COMMON",  @blocks1), undef);
+is(can_make_word("SQUAD",   @blocks1), 1);
+is(can_make_word("CONFUSE", @blocks1), 1);
+
+my @blocks2 = qw(US TZ AO QA);
+is(can_make_word('auto', @blocks2), 1);

Task/ABC-Problem/PicoLisp/abc-problem.l

@@ -0,0 +1,33 @@
+(setq *Blocks
+   '((B O) (X K) (D Q) (C P) (N A) (G T) (R E)
+   (T G) (Q D) (F S) (J W) (H U) (V I) (A N)
+   (O B) (E R) (F S) (L Y) (P C) (Z M) ) )
+(setq *Words '("" "1" "A" "BARK" "BOOK" "TREAT"
+               "Bbb" "COMMON" "SQUAD" "Confuse"
+               "abba" "ANBOCPDQERSFTGUVWXLZ") )
+
+(de abc (W B)
+   (let Myblocks (copy B)
+      (fully
+         '((C)
+            (when (seek '((Lst) (member C (car Lst))) Myblocks)
+               (set @)
+               T ) )
+      (chop (uppc W)) ) ) )
+
+(de abcR (W B)
+   (nond
+      ((car W) T)
+      ((car B) NIL)
+      (NIL
+         (setq W (chop W))
+         (let? I
+            (find
+               '((Lst) (member (uppc (car W)) Lst))
+               B )
+            (abcR (cdr W) (delete I B)) ) ) ) )
+
+(for Word *Words
+   (println Word (abc Word *Blocks) (abcR Word *Blocks)) )
+
+(bye)

Task/ABC-Problem/PowerBASIC/abc-problem.powerbasic

@@ -0,0 +1,155 @@
+#COMPILE EXE
+#DIM ALL
+'
+' A B C p r o b l e m . b a s
+'
+' by  Geary Chopoff
+' for Chopoff Consulting and RosettaCode.org
+' on  2014Jul23
+'
+'2014Jul23
+'
+'You are given a collection of ABC blocks. Just like the ones you had when you were a kid.
+'There are twenty blocks with two letters on each block. You are guaranteed to have a complete
+'alphabet amongst all sides of the blocks. The sample blocks are:
+'((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))
+'The goal of this task is to write a function that takes a string and can determine whether
+'you can spell the word with the given collection of blocks.
+'
+'The rules are simple:
+'1.Once a letter on a block is used that block cannot be used again
+'2.The function should be case-insensitive
+'3. Show your output on this page for the following words:
+'	A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE
+'-----------------------------------------------------------------------------
+' G l o b a l   C o n s t a n t s
+'
+%Verbose = 0                'make this 1 to have a lot of feedback
+%MAX_BLOCKS = 20            'total number of blocks
+%MAX_SIDES = 2              'total number of sides containing a unique letter per block
+
+%MAX_ASC = 255
+%FALSE = 0                  'this is correct because there is ONLY ONE value for FALSE
+%TRUE  = (NOT %FALSE)       'this is one of MANY values of TRUE!
+$FLAG_TRUE = "1"
+$FLAG_FALSE = "0"
+'-----------------------------------------------------------------------------
+' G l o b a l   V a r i a b l e s
+'
+GLOBAL blk() AS STRING
+'-----------------------------------------------------------------------------
+'i n i t B l o c k s
+'
+' as we will use this array only once we build it each time program is run
+'
+SUB initBlocks
+ LOCAL j AS INTEGER
+    j=1
+    blk(j)="BO"
+    j=j+1
+    blk(j)="XK"
+    j=j+1
+    blk(j)="DQ"
+    j=j+1
+    blk(j)="CP"
+    j=j+1
+    blk(j)="NA"
+    j=j+1
+    blk(j)="GT"
+    j=j+1
+    blk(j)="RE"
+    j=j+1
+    blk(j)="TG"
+    j=j+1
+    blk(j)="QD"
+    j=j+1
+    blk(j)="FS"
+    j=j+1
+    blk(j)="JW"
+    j=j+1
+    blk(j)="HU"
+    j=j+1
+    blk(j)="VI"
+    j=j+1
+    blk(j)="AN"
+    j=j+1
+    blk(j)="OB"
+    j=j+1
+    blk(j)="ER"
+    j=j+1
+    blk(j)="FS"
+    j=j+1
+    blk(j)="LY"
+    j=j+1
+    blk(j)="PC"
+    j=j+1
+    blk(j)="ZM"
+    IF j <> %MAX_BLOCKS THEN
+        STDOUT "initBlocks:Error: j is not same as MAX_BLOCKS!",j,%MAX_BLOCKS
+    END IF
+END SUB
+'-----------------------------------------------------------------------------
+' m a k e W o r d
+'
+FUNCTION makeWord(tryWord AS STRING) AS BYTE
+ LOCAL retTF AS BYTE
+ LOCAL j AS INTEGER
+ LOCAL s AS INTEGER         'which side of block we are looking at
+ LOCAL k AS INTEGER
+ LOCAL c AS STRING          'character in tryWord we are looking for
+
+
+    FOR j = 1 TO LEN(tryWord)
+        c = UCASE$(MID$(tryWord,j,1))   'character we want to show with block
+
+        retTF = %FALSE                  'we assume this will fail
+
+        FOR k = 1 TO %MAX_BLOCKS
+            IF LEN(blk(k)) = %MAX_SIDES THEN
+                FOR s = 1 TO %MAX_SIDES
+                    IF c = MID$(blk(k),s,1) THEN
+                        retTF = %TRUE   'this block has letter we want
+                        blk(k) = ""     'remove this block from further consideration
+                        EXIT FOR
+                    END IF
+                NEXT s
+            END IF
+            IF retTF THEN EXIT FOR      'can go on to next character in word
+        NEXT k
+        IF ISFALSE retTF THEN EXIT FOR  'if character not found then all is done
+    NEXT j
+
+    FUNCTION = retTF
+END FUNCTION
+'-----------------------------------------------------------------------------
+' P B M A I N
+'
+FUNCTION PBMAIN () AS LONG
+ DIM blk(1 TO %MAX_BLOCKS, 1 TO %MAX_SIDES) AS STRING
+ LOCAL cmdLine AS STRING
+
+    initBlocks              'setup global array of blocks
+
+    cmdLine=COMMAND$
+    IF LEN(cmdLine)= 0 THEN
+        STDOUT "Useage for ABCproblem Version 1.00:"
+        STDOUT ""
+        STDOUT "     >ABCproblem tryThisWord"
+        STDOUT ""
+        STDOUT "Where tryThisWord is a word you want to see if"+STR$(%MAX_BLOCKS)+" blocks can make."
+        STDOUT "If word can be made TRUE is returned."
+        STDOUT "Otherwise FALSE is returned."
+        EXIT FUNCTION
+    END IF
+
+    IF INSTR(TRIM$(cmdLine)," ") = 0 THEN
+        IF makeWord(cmdLine) THEN
+            STDOUT "TRUE"
+        ELSE
+            STDOUT "FALSE"
+        END IF
+    ELSE
+        STDOUT "Error:Missing word to try to make with blocks!  <" & cmdLine & ">"
+        EXIT FUNCTION
+    END IF
+END FUNCTION

Task/ABC-Problem/Prolog/abc-problem.pro

@@ -0,0 +1,22 @@
+abc_problem :-
+	maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).
+
+
+abc_problem(Word) :-
+	L = [[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]],
+
+	(   abc_problem(L, Word)
+	->  format('~w OK~n', [Word])
+	;   format('~w KO~n', [Word])).
+
+abc_problem(L, Word) :-
+	atom_chars(Word, C_Words),
+	maplist(downcase_atom, C_Words, D_Words),
+	can_makeword(L, D_Words).
+
+can_makeword(_L, []).
+
+can_makeword(L, [H | T]) :-
+	(   select([H, _], L, L1); select([_, H], L, L1)),
+	can_makeword(L1, T).

Task/ABC-Problem/Python/abc-problem-1.py

@@ -0,0 +1,63 @@
+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")]
+
+
+def can_make_word(word, block_collection=blocks):
+    """
+    Return True if `word` can be made from the blocks in `block_collection`.
+
+    >>> can_make_word("")
+    False
+    >>> 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("coNFused")
+    True
+    """
+    if not word:
+        return False
+
+    blocks_remaining = block_collection[:]
+    for char in word.upper():
+        for block in blocks_remaining:
+            if char in block:
+                blocks_remaining.remove(block)
+                break
+        else:
+            return False
+    return True
+
+
+if __name__ == "__main__":
+    import doctest
+    doctest.testmod()
+    print(", ".join("'%s': %s" % (w, can_make_word(w)) for w in
+                    ["", "a", "baRk", "booK", "treat",
+                     "COMMON", "squad", "Confused"]))

Task/ABC-Problem/Python/abc-problem-2.py

@@ -0,0 +1,25 @@
+BLOCKS = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'.split()
+
+def _abc(word, blocks):
+    for i, ch in enumerate(word):
+        for blk in (b for b in blocks if ch in b):
+            whatsleft = word[i + 1:]
+            blksleft = blocks[:]
+            blksleft.remove(blk)
+            if not whatsleft:
+                return True, blksleft
+            if not blksleft:
+                return False, blksleft
+            ans, blksleft = _abc(whatsleft, blksleft)
+            if ans:
+                return ans, blksleft
+        else:
+            break
+    return False, blocks
+
+def abc(word, blocks=BLOCKS):
+    return _abc(word.upper(), blocks)[0]
+
+if __name__ == '__main__':
+    for word in [''] + 'A BARK BoOK TrEAT COmMoN SQUAD conFUsE'.split():
+        print('Can we spell %9r? %r' % (word, abc(word)))

Task/ABC-Problem/Python/abc-problem-3.py

@@ -0,0 +1,16 @@
+def mkword(w, b):
+    if not w: return []
+
+    c,w = w[0],w[1:]
+    for i in range(len(b)):
+        if c in b[i]:
+            m = mkword(w, b[0:i] + b[i+1:])
+            if m != None: return [b[i]] + m
+
+def abc(w, blk):
+    return mkword(w.upper(), [a.upper() for a in blk])
+
+blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'.split()
+
+for w in ", A, bark, book, treat, common, SQUAD, conFUsEd".split(', '):
+    print '\'' + w + '\'' + ' ->', abc(w, blocks)

Task/ABC-Problem/R/abc-problem-1.r

@@ -0,0 +1,43 @@
+blocks <- rbind(c("B","O"),
+ c("X","K"),
+ c("D","Q"),
+ c("C","P"),
+ c("N","A"),
+ c("G","T"),
+ c("R","E"),
+ c("T","G"),
+ c("Q","D"),
+ c("F","S"),
+ c("J","W"),
+ c("H","U"),
+ c("V","I"),
+ c("A","N"),
+ c("O","B"),
+ c("E","R"),
+ c("F","S"),
+ c("L","Y"),
+ c("P","C"),
+ c("Z","M"))
+
+canMake <- function(x) {
+  x <- toupper(x)
+  used <- rep(FALSE, dim(blocks)[1L])
+  charList <- strsplit(x, character(0))
+  tryChars <- function(chars, pos, used, inUse=NA) {
+    if (pos > length(chars)) {
+      TRUE
+    } else {
+      used[inUse] <- TRUE
+      possible <- which(blocks == chars[pos] & !used, arr.ind=TRUE)[, 1L]
+      any(vapply(possible, function(possBlock) tryChars(chars, pos + 1, used, possBlock), logical(1)))
+    }
+  }
+  setNames(vapply(charList, tryChars, logical(1), 1L, used), x)
+}
+canMake(c("A",
+           "BARK",
+           "BOOK",
+           "TREAT",
+           "COMMON",
+           "SQUAD",
+           "CONFUSE"))

Task/ABC-Problem/R/abc-problem-2.r

@@ -0,0 +1,21 @@
+canMakeNoRecursion <- function(x) {
+  x <- toupper(x)
+  charList <- strsplit(x, character(0))
+  getCombos <- function(chars) {
+    charBlocks <-  data.matrix(expand.grid(lapply(chars, function(char) which(blocks == char, arr.ind=TRUE)[, 1L])))
+    charBlocks <- charBlocks[!apply(charBlocks, 1, function(row) any(duplicated(row))), , drop=FALSE]
+    if (dim(charBlocks)[1L] > 0L) {
+      t(apply(charBlocks, 1, function(row) apply(blocks[row, , drop=FALSE], 1, paste, collapse="")))
+    } else {
+      character(0)
+    }
+  }
+  setNames(lapply(charList, getCombos), x)
+}
+canMakeNoRecursion(c("A",
+           "BARK",
+           "BOOK",
+           "TREAT",
+           "COMMON",
+           "SQUAD",
+           "CONFUSE"))

Task/ABC-Problem/README

@@ -0,0 +1 @@
+Data source: http://rosettacode.org/wiki/ABC_Problem

Task/ABC-Problem/REXX/abc-problem-1.rexx

@@ -0,0 +1,24 @@
+/*REXX pgm checks if a word list can be spelt from a pool of toy blocks.*/
+list = 'A bark bOOk treat common squaD conFuse' /*words can be any case.*/
+blocks =     'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'
+       do k=1  for  words(list)        /*traipse through list of words. */
+       call  spell  word(list,k)       /*show if word be spelt (or not).*/
+       end   /*k*/                     /* [↑] tests each word in list.  */
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────SPELL subroutine────────────────────*/
+spell: procedure expose blocks; parse arg ox . 1 x . /*get word to spell*/
+z=blocks; upper x z;  oz=z;  p.=0;  L=length(x) /*uppercase the blocks. */
+                                                /* [↓]  try to spell it.*/
+  do try=1  for  L;   z=oz                      /*use a fresh copy of Z.*/
+    do n=1  for  L;   y=substr(x,n,1)           /*attempt another letter*/
+    p.n=pos(y,z,1+p.n); if p.n==0 then iterate try /*¬ found? Try again.*/
+    z=overlay(' ',z,p.n)                        /*mutate block──► onesy.*/
+      do k=1  for words(blocks)                 /*scrub block pool (¬1s)*/
+      if length(word(z,k))==1  then z=delword(z,k,1)  /*1 char?  Delete.*/
+      end   /*k*/                               /* [↑]  elide any onesy.*/
+    if n==L   then leave try                    /*the last letter spelt?*/
+    end     /*n*/                               /* [↑] end of an attempt*/
+  end       /*try*/                             /* [↑]  end TRY permute.*/
+
+say right(ox,30)   right(word("can't can", (n==L)+1),  6)      'be spelt.'
+return n==L                                     /*also, return the flag.*/

Task/ABC-Problem/REXX/abc-problem-2.rexx

@@ -0,0 +1,103 @@
+/* REXX ---------------------------------------------------------------
+* 10.01.2014 Walter Pachl  counts the number of possible ways
+* 12.01.2014 corrected date and output
+*--------------------------------------------------------------------*/
+show=(arg(1)<>'')
+blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'
+list = '$ A baRk bOOk trEat coMMon squaD conFuse'
+list=translate(list)
+Do i=1 To words(blocks)
+  blkn.i=word(blocks,i)'-'i
+  blk.i=word(blocks,i)
+  End
+w.=''
+wlen=0
+Do i=1 To words(list)
+  w.i=word(list,i)
+  wlen=max(wlen,length(w.i))
+  End
+Do wi=0 To words(list)
+  word = w.wi
+  ways=0
+  poss.=0
+  lw=length(word)
+  cannot=0
+  Do i=1 To lw                         /* loop over the characters   */
+    c=substr(word,i,1)                 /* the current character      */
+    Do j=1 To words(blocks)            /* loop over blocks           */
+      blk=word(blocks,j)
+      If pos(c,blk)>0 Then Do  /* block can be used in this position */
+        z=poss.i.0+1
+        poss.i.z=j
+        poss.i.0=z            /* number of possible blocks for pos i */
+        End
+      End
+    If poss.i.0=0 Then Do
+      cannot=1
+      Leave i
+      End
+    End
+
+  If cannot=0 Then Do                  /* no prohibitive character   */
+    s.=0
+    Do j=1 To poss.1.0          /* build possible strings for char 1 */
+      z=s.1.0+1
+      s.1.z=poss.1.j
+      s.1.0=z
+      End
+    Do i=2 To lw          /* build possible strings for chars 1 to i */
+      ii=i-1
+      Do j=1 To poss.i.0
+        Do k=1 To s.ii.0
+          z=s.i.0+1
+          s.i.z=s.ii.k poss.i.j
+          s.i.0=z
+          End
+        End
+      End
+    Do p=1 To s.lw.0            /* loop through all possible strings */
+      v=valid(s.lw.p)                  /* test if the string is valid*/
+      If v Then Do                     /* it is                      */
+        ways=ways+1                    /* increment number of ways   */
+        way.ways=''                 /* and store the string's blocks */
+        Do ii=1 To lw
+          z=word(s.lw.p,ii)
+          way.ways=way.ways blk.z
+          End
+        End
+      End
+    End
+/*---------------------------------------------------------------------
+* now show the result
+*--------------------------------------------------------------------*/
+  ol=left(''''word'''',wlen+2)
+  Select
+    When ways=0 Then
+      ol=ol 'cannot be spelt'
+    When ways=1 Then
+      ol=ol 'can be spelt'
+    Otherwise
+      ol=ol 'can be spelt in' ways 'ways'
+    End
+  Say ol'.'
+  If show Then Do
+    Do wj=1 To ways
+      Say copies(' ',10) way.wj
+      End
+    End
+  End
+Exit
+
+valid: Procedure
+/*---------------------------------------------------------------------
+* Check if the same block is used more than once -> 0
+* Else: the combination is valid
+*--------------------------------------------------------------------*/
+  Parse Arg list
+  used.=0
+  Do i=1 To words(list)
+    w=word(list,i)
+    If used.w Then Return 0
+    used.w=1
+    End
+  Return 1

Task/ABC-Problem/Racket/abc-problem.rkt

@@ -0,0 +1,43 @@
+#lang racket
+(define block-strings
+  (list "BO" "XK" "DQ" "CP" "NA"
+        "GT" "RE" "TG" "QD" "FS"
+        "JW" "HU" "VI" "AN" "OB"
+        "ER" "FS" "LY" "PC" "ZM"))
+(define BLOCKS (map string->list block-strings))
+
+(define (can-make-word? w)
+  (define (usable-block blocks word-char)
+    (for/first ((b (in-list blocks)) #:when (memf (curry char-ci=? word-char) b)) b))
+
+  (define (inner word-chars blocks tried-blocks)
+    (cond
+      [(null? word-chars) #t]
+      [(usable-block blocks (car word-chars))
+       =>
+       (lambda (b)
+         (or
+          (inner (cdr word-chars) (append tried-blocks (remove b blocks)) null)
+          (inner word-chars (remove b blocks) (cons b tried-blocks))))]
+      [else #f]))
+  (inner (string->list w) BLOCKS null))
+
+(define WORD-LIST '("" "A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE"))
+(define (report-word w)
+  (printf "Can we make: ~a? ~a~%"
+          (~s w #:min-width 9)
+          (if (can-make-word? w) "yes" "no")))
+
+(module+ main
+  (for-each report-word WORD-LIST))
+
+(module+ test
+  (require rackunit)
+  (check-true  (can-make-word? ""))
+  (check-true  (can-make-word? "A"))
+  (check-true  (can-make-word? "BARK"))
+  (check-false (can-make-word? "BOOK"))
+  (check-true  (can-make-word? "TREAT"))
+  (check-false (can-make-word? "COMMON"))
+  (check-true  (can-make-word? "SQUAD"))
+  (check-true  (can-make-word? "CONFUSE")))

Task/ABC-Problem/RapidQ/abc-problem.rapidq

@@ -0,0 +1,26 @@
+dim Blocks as string
+dim InWord as string
+
+Function CanMakeWord (FInWord as string, FBlocks as string) as integer
+    dim WIndex as integer, BIndex as integer
+
+    FBlocks = UCase$(FBlocks) - " " - ","
+    FInWord = UCase$(FInWord)
+
+    for WIndex = 1 to len(FInWord)
+        BIndex = instr(FBlocks, FInWord[WIndex])
+
+        if BIndex then
+            FBlocks = Replace$(FBlocks,"**",iif(BIndex mod 2,BIndex,BIndex-1))
+        else
+            Result = 0
+            exit function
+        end if
+    next
+
+    Result = 1
+end function
+
+InWord = "Confuse"
+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")

Task/ABC-Problem/Ruby/abc-problem.rb

@@ -0,0 +1,7 @@
+words = %w(A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE) << ""
+
+words.each do |word|
+  blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
+  res = word.each_char.all?{|c| blocks.sub!(/\w?#{c}\w?/i, "")}  #regexps can be interpolated like strings
+  puts "#{word.inspect}: #{res}"
+end

Task/ABC-Problem/Rust/abc-problem.rust

@@ -0,0 +1,33 @@
+#![feature(core, unicode)]
+extern crate core;
+extern crate unicode;
+
+use core::iter::repeat;
+use core::str::StrExt;
+use unicode::char::CharExt;
+
+fn rec_can_make_word(index: usize, word: &str, blocks: &[&str], used: &mut[bool]) -> bool {
+	let c = word.char_at(index).to_uppercase();
+	for i in range(0, blocks.len()) {
+		if !used[i] && blocks[i].chars().any(|s| s == c) {
+			used[i] = true;
+			if index == 0 || rec_can_make_word(index - 1, word, blocks, used) {
+				return true;
+			}
+			used[i] = false;
+		}
+	}
+	false
+}
+			
+fn can_make_word(word: &str, blocks: &[&str]) -> bool {
+	return rec_can_make_word(word.char_len() - 1, word, blocks, repeat(false).take(blocks.len()).collect::<Vec<_>>().as_mut_slice());
+}
+
+fn main() {
+	let blocks = [("BO"), ("XK"), ("DQ"), ("CP"), ("NA"), ("GT"), ("RE"), ("TG"), ("QD"), ("FS"), ("JW"), ("HU"), ("VI"), ("AN"), ("OB"), ("ER"), ("FS"), ("LY"), ("PC"), ("ZM")];	
+	let words = ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"];
+	for word in words.iter() {
+		println!("{} -> {}", word, can_make_word(word.as_slice(), blocks.as_slice()))
+	}
+}

Task/ABC-Problem/Scala/abc-problem.scala

@@ -0,0 +1,50 @@
+object AbcBlocks extends App {
+
+  protected class Block(face1: Char, face2: Char) {
+
+    def isFacedWith(that: Char) = { that == face1 || that == face2 }
+    override def toString() = face1.toString + face2
+  }
+  protected object Block {
+    def apply(faces: String) = new Block(faces.head, faces.last)
+  }
+
+  type word = Seq[Block]
+
+  private val blocks = List(Block("BO"), Block("XK"), Block("DQ"), Block("CP"), Block("NA"),
+    Block("GT"), Block("RE"), Block("TG"), Block("QD"), Block("FS"),
+    Block("JW"), Block("HU"), Block("VI"), Block("AN"), Block("OB"),
+    Block("ER"), Block("FS"), Block("LY"), Block("PC"), Block("ZM"))
+
+  private def isMakeable(word: String, blocks: word) = {
+
+    def getTheBlocks(word: String, blocks: word) = {
+
+      def inner(word: String, toCompare: word, rest: word, accu: word): word = {
+        if (word.isEmpty || rest.isEmpty || toCompare.isEmpty) accu
+        else if (toCompare.head.isFacedWith(word.head)) {
+          val restant = rest diff List(toCompare.head)
+          inner(word.tail, restant, restant, accu :+ toCompare.head)
+        } else inner(word, toCompare.tail, rest, accu)
+      }
+      inner(word, blocks, blocks, Nil)
+    }
+
+    word.lengthCompare(getTheBlocks(word, blocks).size) == 0
+  }
+
+  val words = List("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSED", "ANBOCPDQERSFTGUVWXLZ")
+  // Automatic tests
+  assert(isMakeable(words(0), blocks))
+  assert(isMakeable(words(1), blocks))
+  assert(!isMakeable(words(2), blocks)) // BOOK not
+  assert(isMakeable(words(3), blocks))
+  assert(!isMakeable(words(4), blocks)) // COMMON not
+  assert(isMakeable(words(5), blocks))
+  assert(isMakeable(words(6), blocks))
+  assert(isMakeable(words(7), blocks))
+
+  //words(7).mkString.permutations.foreach(s => assert(isMakeable(s, blocks)))
+
+  words.foreach(w => println(s"$w can${if (isMakeable(w, blocks)) " " else "not "}be made."))
+}

Task/ABC-Problem/Seed7/abc-problem.seed7

@@ -0,0 +1,34 @@
+$ include "seed7_05.s7i";
+
+const func boolean: canMakeWords (in array string: blocks, in string: word) is func
+  result
+    var boolean: okay is FALSE;
+  local
+    var integer: index is 1;
+  begin
+    if word = "" then
+      okay := TRUE;
+    elsif length(blocks) <> 0 then
+      while index <= length(blocks) and not okay do
+        if blocks[index][1] = word[1] or blocks[index][2] = word[1] then
+          okay := canMakeWords(blocks[.. pred(index)] & blocks[succ(index) ..], word[2 ..]);
+        end if;
+        incr(index);
+      end while;
+    end if;
+  end func;
+
+const array string: blocks is [] ("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
+                                  "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM");
+
+const func boolean: canMakeWords (in string: word) is
+  return canMakeWords(blocks, upper(word));
+
+const proc: main is func
+  local
+    var string: word is "";
+  begin
+    for word range [] ("", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse") do
+      writeln(word rpad 10 <& canMakeWords(word));
+    end for;
+  end func;

Task/ABC-Problem/Smalltalk/abc-problem.st

@@ -0,0 +1,21 @@
+ABCPuzzle>>test
+	#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
+		Transcript crShow: each, ': ', (self solveFor: each) asString ]
+
+ABCPuzzle>>solveFor: letters
+	| blocks |
+	blocks := #('BO' 'XK' 'DQ' 'CP' 'NA' 'GT' 'RE' 'TG' 'QD' 'FS' 'JW' 'HU' 'VI' 'AN' 'OB' 'ER' 'FS' 'LY' 'PC' 'ZM').
+	^ self solveFor: letters asUppercase with: blocks asOrderedCollection
+
+ABCPuzzle>>solveFor: letters with: blocks
+	| l ldash matches |
+	letters isEmpty ifTrue: [ ^ true ].
+	l := letters first.
+	ldash := letters allButFirst.
+	matches := blocks select: [  :b | b includes: l ].
+	matches isEmpty ifTrue: [ ^ false ].
+	matches do: [  :m | | bdash |
+		bdash := blocks copy.
+		bdash remove: m.
+		(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
+	^ false

Task/ABC-Problem/TUSCRIPT/abc-problem.tu

@@ -0,0 +1,18 @@
+set words = "A'BARK'BOOK'TREAT'COMMON'SQUAD'CONFUSE"
+set result = *
+loop word = words
+   set blocks = "BO'XK'DQ'CP'NA'GT'RE'TG'QD'FS'JW'HU'VI'AN'OB'ER'FS'LY'PC'ZM"
+   set wordx = split (word, |"~</~")
+   set cond = "true"
+   loop char = wordx
+      set n = filter_index (blocks, "~*{char}*~", -)
+      if (n.eq."") then
+         set cond = "false"
+         exit
+      endif
+      set n2 = select (n, 1)
+      set n3 = select (blocks, #n2, blocks)
+   endloop
+   set out = concat (word, " ", cond)
+   set result = append (result, out)
+endloop

Task/ABC-Problem/TXR/abc-problem.txr

@@ -0,0 +1,47 @@
+@(do
+   (defvar blocks '((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G)
+                    (Q D) (F S) (J W) (H U) (V I) (A N) (O B) (E R)
+                    (F S) (L Y) (P C) (Z M)))
+
+   ;; Define and build hash which maps each letter that occurs in blocks
+   ;; to a list of the blocks in which that letter occurs.
+
+   (defvar alpha2blocks [hash-uni [group-by first blocks]
+                                  [group-by second blocks]
+                                  append])
+
+   ;; convert, e.g. "abc" -> (A B C)
+   ;; intern -- convert a string to an interned symbol "A" -> A
+   ;; tuples -- turn string into 1-element tuples: "ABC" -> ("A" "B" "C")
+   ;; square brackets around mapcar -- Lisp-1 style evaluation, allowing
+   ;;   the intern function binding to be treated as a variable binding.
+
+   (defun string-to-syms (str)
+     [mapcar intern (tuples 1 (upcase-str str))])
+
+   ;; Recursive part of algorithm working purely with Lisp symbols.
+   ;; alpha -- single symbol denoting a letter
+   ;; [alpha2blocks alpha] -- look up list of blocks for given letter
+   ;; (memq item list) -- is item a member of list, under eq equality?
+   ;; (remq item list) -- remove items from list which are eq to item.
+
+   (defun can-make-word-guts (letters blocks)
+     (cond
+       ((null letters) t)
+       ((null blocks) nil)
+       (t (let ((alpha (first letters)))
+            (each ((bl [alpha2blocks alpha]))
+              (if (and (memq bl blocks)
+                       (can-make-word-guts (rest letters)
+                                           (remq bl blocks)))
+                (return-from can-make-word-guts t)))))))
+
+   (defun can-make-word (str)
+     (can-make-word-guts (string-to-syms str) blocks)))
+@(repeat)
+@w
+@(output)
+>>> can_make_word("@(upcase-str w)")
+@(if (can-make-word w) "True" "False")
+@(end)
+@(end)

Task/ABC-Problem/Tcl/abc-problem.tcl

@@ -0,0 +1,21 @@
+package require Tcl 8.6
+
+proc abc {word {blocks {BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM}}} {
+    set abc {{letters blocks abc} {
+	set rest [lassign $letters ch]
+	set i 0
+	foreach blk $blocks {
+	    if {$ch in $blk && (![llength $rest]
+		    || [apply $abc $rest [lreplace $blocks $i $i] $abc])} {
+		return true
+	    }
+	    incr i
+	}
+	return false
+    }}
+    return [apply $abc [split $word ""] [lmap b $blocks {split $b ""}] $abc]
+}
+
+foreach word {"" A BARK BOOK TREAT COMMON SQUAD CONFUSE} {
+    puts [format "Can we spell %9s? %s" '$word' [abc $word]]
+}

Task/ABC-Problem/UNIX-Shell/abc-problem.sh

@@ -0,0 +1,39 @@
+can_build_word() {
+    if [[ $1 ]]; then
+        can_build_word_rec "$1" BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
+    else
+        return 1
+    fi
+}
+
+can_build_word_rec() {
+    [[ -z $1 ]] && return 0
+
+    local -u word=$1       # uppercase the first parameter
+    shift
+    local blocks=("$@")
+
+    # see if we have a block for the first letter
+    local letter=${word:0:1} indices=() i
+    for (( i=0; i<${#blocks[@]}; i++ )); do
+        if [[ ${blocks[i]} == *$letter* ]]; then
+            indices+=($i)
+        fi
+    done
+    (( ${#indices[@]} == 0 )) && return 1
+
+    local tmp
+    for i in ${indices[@]}; do
+        tmp=( "${blocks[@]}" )
+        unset "tmp[$i]"
+        can_build_word_rec "${word:1}" "${tmp[@]}" && return 0
+    done
+
+    return 1
+}
+
+words=( "" A BARK Book treat COMMON Squad confuse )
+for word in "${words[@]}"; do
+    can_build_word "$word" "${blocks[@]}" && ans=yes || ans=no
+    printf "%s\t%s\n" "$word" $ans
+done