Another update from ingydotnet^djgoku

Task/ABC-Problem/ALGOL-68/abc-problem.alg

@@ -0,0 +1,80 @@
+# determine whether we can spell words with a set of blocks                  #
+
+# construct the list of blocks                                               #
+[][]STRING 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" )
+                    );
+
+# Returns TRUE if we can spell the word using the blocks, FALSE otherwise    #
+# Returns TRUE for an empty string                                           #
+PROC can spell = ( STRING word, [][]STRING blocks )BOOL:
+    BEGIN
+
+        # construct a set of flags to indicate whether the blocks are used   #
+        # or not                                                             #
+        [ 1 LWB blocks : 1 UPB blocks ]BOOL used;
+        FOR block pos FROM LWB used TO UPB used
+        DO
+            used[ block pos ] := FALSE
+        OD;
+
+        # initialliy assume we can spell the word                            #
+        BOOL result := TRUE;
+
+        # check we can spell the word with the set of blocks                 #
+        FOR word pos FROM LWB word TO UPB word WHILE result
+        DO
+            CHAR c = IF   is lower( word[ word pos ] )
+                     THEN to upper( word[ word pos ] )
+                     ELSE           word[ word pos ]
+                     FI;
+
+            # look through the unused blocks for the current letter          #
+            BOOL found := FALSE;
+            FOR block pos FROM 1 LWB blocks TO 1 UPB blocks
+            WHILE NOT found
+            DO
+                IF  (  c = blocks[ block pos ][ 1 ][ 1 ]
+                    OR c = blocks[ block pos ][ 2 ][ 1 ]
+                    )
+                AND NOT used[ block pos ]
+                THEN
+                    # found an unused block with the required letter         #
+                    found             := TRUE;
+                    used[ block pos ] := TRUE
+                FI
+            OD;
+
+            result := found
+
+        OD;
+
+        result
+    END; # can spell #
+
+
+main: (
+
+    # test the can spell procedure                                           #
+    PROC test can spell = ( STRING word, [][]STRING blocks )VOID:
+        write( ( ( "can spell: """
+                 + word
+                 + """ -> "
+                 + IF can spell( word, blocks ) THEN "yes" ELSE "no" FI
+                 )
+               , newline
+               )
+             );
+
+    test can spell( "A",       blocks );
+    test can spell( "BaRK",    blocks );
+    test can spell( "BOOK",    blocks );
+    test can spell( "TREAT",   blocks );
+    test can spell( "COMMON",  blocks );
+    test can spell( "SQUAD",   blocks );
+    test can spell( "CONFUSE", blocks )
+
+)

Task/ABC-Problem/ALGOL-W/abc-problem.alg

@@ -0,0 +1,81 @@
+% determine whether we can spell words with a set of blocks                  %
+begin
+    % Returns true  if we can spell the word using the blocks,               %
+    %         false otherwise                                                %
+    % As strings are fixed length in Algol W, the length of the string is    %
+    % passed as a separate parameter                                         %
+    logical procedure canSpell ( string(20) value word
+                               ; integer    value wordLength
+                               ) ;
+    begin
+
+        % convert a character to upper-case                                  %
+        % assumes the letters are contiguous in the character set            %
+        % as in ASCII and Unicode - not correct for EBCDIC                   %
+        string(1) procedure toUpper( string(1) value c ) ;
+            if c < "a" or c > "z" then c
+                                  else code( ( decode( c ) - decode( "a" ) )
+                                           + decode( "A" )
+                                           ) ;
+
+        logical       spellable;
+        integer       wordPos,  blockPos;
+        string(20)    letters1, letters2;
+
+        % make local copies the faces so we can remove the used blocks       %
+        letters1 := face1;
+        letters2 := face2;
+
+        % check we can spell the word with the set of blocks                 %
+        spellable := true;
+        wordPos   := 0;
+        while wordPos < wordLength and spellable do begin
+            string(1) letter;
+            letter    := toUpper( word( wordPos // 1 ) );
+            if letter not = " " then begin
+                spellable := false;
+                blockPos  := 0;
+                while blockPos < 20 and not spellable do begin
+                    if letter = letters1( blockPos // 1 )
+                    or letter = letters2( blockPos // 1 )
+                    then begin
+                        % found the letter - remove the used block from the  %
+                        % remaining blocks                                   %
+                        letters1( blockPos // 1 ) := " ";
+                        letters2( blockPos // 1 ) := " ";
+                        spellable := true
+                    end;
+                    blockPos := blockPos + 1
+                end
+            end;
+            wordPos := wordPos + 1;
+        end;
+
+        spellable
+    end canSpell ;
+
+    % the letters available on the faces of the blocks                       %
+    string(20) face1, face2;
+    face1 := "BXDCNGRTQFJHVAOEFLPZ";
+    face2 := "OKQPATEGDSWUINBRSYCM";
+
+    begin
+        % test the can spell procedure                                       %
+        procedure testCanSpell ( string(20) value word
+                               ; integer    value wordLength
+                               ) ;
+            write( if canSpell( word, wordLength ) then "can   " else "cannot"
+                 , " spell """
+                 , word
+                 , """"
+                 );
+
+        testCanSpell( "a",       1 );
+        testCanSpell( "bark",    4 );
+        testCanSpell( "BOOK",    4 );
+        testCanSpell( "treat",   5 );
+        testCanSpell( "commoN",  6 );
+        testCanSpell( "Squad",   5 );
+        testCanSpell( "confuse", 7 )
+    end
+end.

Task/ABC-Problem/AppleScript/abc-problem.applescript

@@ -0,0 +1,27 @@
+set blocks to {"bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs", "jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}
+
+canMakeWordWithBlocks("a", blocks)
+canMakeWordWithBlocks("bark", blocks)
+canMakeWordWithBlocks("book", blocks)
+canMakeWordWithBlocks("treat", blocks)
+canMakeWordWithBlocks("common", blocks)
+canMakeWordWithBlocks("squad", blocks)
+canMakeWordWithBlocks("confuse", blocks)
+
+on canMakeWordWithBlocks(theString, constBlocks)
+	copy constBlocks to theBlocks
+	if theString = "" then return true
+	set i to 1
+	repeat
+		if i > (count theBlocks) then exit repeat
+		if character 1 of theString is in item i of theBlocks then
+			set item i of theBlocks to missing value
+			set theBlocks to strings of theBlocks
+			if canMakeWordWithBlocks(rest of characters of theString as string, theBlocks) then
+				return true
+			end if
+		end if
+		set i to i + 1
+	end repeat
+	return false
+end canMakeWordWithBlocks

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

@@ -0,0 +1,30 @@
+using System;
+using System.IO;
+// Needed for the method.
+using System.Text.RegularExpressions;
+using System.Collections.Generic;
+
+void Main()
+{
+   string blocks = "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"
+   };
+
+   foreach(var word in words)
+   {
+      Console.WriteLine("{0}: {1}", word, CheckWord(blocks, word));
+   }
+}
+
+bool CheckWord(string blocks, string word)
+{
+   for(int i = 0; i < word.Length; ++i)
+   {
+      int length = blocks.Length;
+      Regex rgx = new Regex("([a-z]"+word[i]+"|"+word[i]+"[a-z])", RegexOptions.IgnoreCase);
+      blocks = rgx.Replace(blocks, "", 1);
+      if(blocks.Length == length) return false;
+   }
+   return true;
+}

Task/ABC-Problem/Elixir/abc-problem.elixir

@@ -0,0 +1,16 @@
+defmodule ABC do
+  def can_make_word(word, avail) do
+    can_make_word(String.upcase(word) |> to_char_list, avail, [])
+  end
+
+  defp can_make_word([], _, _), do: true
+  defp can_make_word(_, [], _), do: false
+  defp can_make_word([l|tail], [b|rest], tried) do
+    (Enum.member?(b,l) and can_make_word(tail, rest++tried, []))
+    or can_make_word([l|tail], rest, [b|tried])
+  end
+end
+
+blocks = ~w(BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM)c
+~w(A Bark Book Treat Common Squad Confuse) |>
+Enum.map(fn(w) -> IO.puts "#{w}: #{ABC.can_make_word(w, blocks)}" end)

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

@@ -1,3 +1,4 @@
 delElem=: {~<@<@<
 uppc=:(-32*96&<*.123&>)&.(3&u:)
 reduc=: ] delElem  1 i.~e."0 1
+forms=:  (1 - '' -: (reduc L:0/ :: (a:"_)@(<"0@],<@[))&uppc) L:0

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

@@ -0,0 +1,14 @@
+   Blocks canform 0{::ExampleWords
+1
+   word
+A
+   need
+2
+   relevant
+NA
+AN
+   candidates
+ANA
+ANN
+AAA
+AAN

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

@@ -0,0 +1,37 @@
+var blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
+
+function CheckWord(blocks, word) {
+   // Makes sure that word only contains letters.
+   if(word !== /([a-z]*)/i.exec(word)[1]) return false;
+   // Loops through each character to see if a block exists.
+   for(var i = 0; i < word.length; ++i)
+   {
+      // Gets the ith character.
+      var letter = word.charAt(i);
+      // Stores the length of the blocks to determine if a block was removed.
+      var length = blocks.length;
+      // The regexp gets constructed by eval to allow more browsers to use the function.
+      var reg = eval("/([a-z]"+letter+"|"+letter+"[a-z])/i");
+      // This does the same as above, but some browsers do not support...
+      //var reg = new RegExp("([a-z]"+letter+"|"+letter+"[a-z])", "i");
+      // Removes all occurrences of the match.
+      blocks = blocks.replace(reg, "");
+      // If the length did not change then a block did not exist.
+      if(blocks.length === length) return false;
+   }
+   // If every character has passed then return true.
+   return true;
+};
+
+var words = [
+   "A",
+   "BARK",
+   "BOOK",
+   "TREAT",
+   "COMMON",
+   "SQUAD",
+   "CONFUSE"
+];
+
+for(var i = 0;i<words.length;++i)
+   console.log(words[i] + ": " + CheckWord(blocks, words[i]));

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

@@ -0,0 +1,48 @@
+(function (strWords) {
+
+    var strBlocks =
+        'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM',
+        blocks = strBlocks.split(' ');
+
+    function abc(lstBlocks, strWord) {
+        var lngChars = strWord.length;
+
+        if (!lngChars) return [];
+
+        var b = lstBlocks[0],
+            c = strWord[0];
+
+        return chain(lstBlocks, function (b) {
+            return (b.indexOf(c.toUpperCase()) !== -1) ? [
+                (b + ' ').concat(
+                    abc(removed(b, lstBlocks), strWord.slice(1)))
+            ] : [];
+        })
+    }
+
+    // Monadic bind (chain) for lists
+    function chain(xs, f) {
+        return [].concat.apply([], xs.map(f));
+    }
+
+    // a -> [a] -> [a]
+    function removed(x, xs) {
+        var h = xs.length ? xs[0] : null,
+            t = h ? xs.slice(1) : [];
+
+        return h ? (
+            h === x ? t : [h].concat(removed(x, t))
+        ) : [];
+    }
+
+    function solution(strWord) {
+        var strAttempt = abc(blocks, strWord)[0].split(',')[0];
+
+        // two chars per block plus one space -> 3
+        return strWord + ((strAttempt.length === strWord.length * 3) ?
+            ' -> ' + strAttempt : ': [no solution]');
+    }
+
+    return strWords.split(' ').map(solution).join('\n');
+
+})('A bark BooK TReAT COMMON squAD conFUSE');

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

@@ -0,0 +1,7 @@
+A -> NA
+bark -> BO NA RE XK
+BooK: [no solution]
+TReAT -> GT RE ER NA TG
+COMMON: [no solution]
+squAD -> FS DQ HU NA QD
+conFUSE -> CP BO NA FS HU FS RE

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

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

Task/ABC-Problem/Objeck/abc-problem.objeck

@@ -0,0 +1,46 @@
+class Abc {
+  function : Main(args : String[]) ~ Nil {
+    blocks := ["BO", "XK", "DQ", "CP", "NA",
+      "GT", "RE", "TG", "QD", "FS",
+      "JW", "HU", "VI", "AN", "OB",
+      "ER", "FS", "LY", "PC", "ZM"];
+
+    IO.Console->Print("\"\": ")->PrintLine(CanMakeWord("", blocks));
+    IO.Console->Print("A: ")->PrintLine(CanMakeWord("A", blocks));
+    IO.Console->Print("BARK: ")->PrintLine(CanMakeWord("BARK", blocks));
+    IO.Console->Print("book: ")->PrintLine(CanMakeWord("book", blocks));
+    IO.Console->Print("treat: ")->PrintLine(CanMakeWord("treat", blocks));
+    IO.Console->Print("COMMON: ")->PrintLine(CanMakeWord("COMMON", blocks));
+    IO.Console->Print("SQuAd: ")->PrintLine(CanMakeWord("SQuAd", blocks));
+    IO.Console->Print("CONFUSE: ")->PrintLine(CanMakeWord("CONFUSE", blocks));
+  }
+
+  function : CanMakeWord(word : String, blocks : String[]) ~ Bool {
+    if(word->Size() = 0) {
+          return true;
+    };
+
+      c := word->Get(0)->ToUpper();
+      for(i := 0; i < blocks->Size(); i++;) {
+      b := blocks[i];
+      if(<>(b->Get(0)->ToUpper() <> c & b->Get(1)->ToUpper() <> c)) {
+        Swap(0, i, blocks);
+        new_word := word->SubString(1, word->Size() - 1);
+        new_blocks := String->New[blocks->Size() - 1];
+        Runtime->Copy(new_blocks, 0, blocks, 1, blocks->Size() - 1);
+        if(CanMakeWord(new_word, new_blocks)) {
+          return true;
+        };
+        Swap(0, i, blocks);
+      };
+    };
+
+    return false;
+  }
+
+  function : native : Swap(i : Int, j : Int, arr : String[]) ~ Nil {
+    tmp := arr[i];
+    arr[i] := arr[j];
+    arr[j] := tmp;
+  }
+}

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

@@ -1,6 +1,6 @@
 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;
+    can-spell-word $word.uc.comb.list, @regex;
 }
 
 multi can-spell-word([$head,*@tail], @regex) {
@@ -8,7 +8,7 @@ multi can-spell-word([$head,*@tail], @regex) {
         if $head ~~ $re {
             return True unless @tail;
             return False if @regex == 1;
-            return True if can-spell-word @tail, @regex.grep: * !=== $re;
+            return True if can-spell-word @tail, list @regex.grep: * !=== $re;
         }
     }
     False;

Task/ABC-Problem/PowerShell/abc-problem.psh

@@ -0,0 +1,117 @@
+<#
+.Synopsis
+  ABC Problem
+.DESCRIPTION
+   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
+   blocks = "BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"
+   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:
+        >>> 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
+
+   Using the examples below  you can either see just the value or
+   status and the values using the verbose switch
+
+.EXAMPLE
+   test-blocks -testword confuse
+
+.EXAMPLE
+   test-blocks -testword confuse -verbose
+
+#>
+
+function test-blocks
+{
+	[CmdletBinding()]
+	#  [OutputType([int])]
+	Param
+	(
+		# word to test against blocks
+		[Parameter(Mandatory = $true,
+				   ValueFromPipelineByPropertyName = $true)]
+		$testword
+		
+	)
+
+	$word = $testword
+	
+	#define array of blocks
+	[System.Collections.ArrayList]$blockarray = "BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"
+	
+	#send word to chararray
+	$chararray = $word.ToCharArray()
+	$chars = $chararray
+	
+	#get the character count
+	$charscount = $chars.count
+	
+	#get the initial count of the blocks
+	$blockcount = $blockarray.Count
+	
+	#find out how many blocks should be left from the difference
+	#of the blocks and characters in the word - 1 letter/1 block
+	$correctblockcount = $blockcount - $charscount
+	
+	#loop through the characters in the word
+	foreach ($char in $chars)
+	{
+		
+		#loop through the blocks
+		foreach ($block in $blockarray)
+		{
+			
+			#check the current character against each letter on the current block
+			#and break if found so the array can reload
+			if ($char -in $block[0] -or $char -in $block[1])
+			{
+				
+				write-verbose "match for letter - $char - removing block $block"
+				$blockarray.Remove($block)
+				break
+				
+			}
+			
+		}
+		
+	}
+	#get final count of blocks left in array to determine if the word was
+	#correctly made
+	$finalblockcount = $blockarray.count
+	if ($finalblockcount -ne $correctblockcount)
+	{
+		write-verbose "$word : $false "
+		return $false
+	}
+	else
+	{
+		write-verbose "$word : $true "
+		return $true
+	}
+	
+}
+
+#loop all the words and pass them to the function
+$wordlist = "a", "bark", "book", "treat", "common", "squad", "confuse"
+foreach ($word in $wordlist)
+{
+	test-blocks -testword $word -Verbose
+}

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

@@ -0,0 +1,18 @@
+:- use_module([ library(chr),
+                abathslib(protelog/composer) ]).
+
+:- chr_constraint blocks, block/1, letter/1, word_built.
+
+can_build_word(Word) :-
+    maplist(block, [(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)]),
+    maplist(letter) <- string_chars <- string_lower(Word),     %% using the `composer` module
+    word_built,
+    !.
+
+'take letter and block'  @ letter(L), block((A,B)) <=> L == A ; L == B | true.
+'fail if letters remain' @ word_built, letter(_)   <=> false.
+
+%% These rules, removing remaining constraints from the store, are just cosmetic:
+'clean up blocks' @ word_built \ block(_) <=> true.
+'word was built'  @ word_built            <=> true.

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

@@ -0,0 +1,14 @@
+?- can_build_word("A").
+true.
+?- can_build_word("BARK").
+true.
+?- can_build_word("BOOK").
+false.
+?- can_build_word("TREAT").
+true.
+?- can_build_word("COMMON").
+false.
+?- can_build_word("SQUAD").
+true.
+?- can_build_word("CONFUSE").
+true.

Task/ABC-Problem/PureBasic/abc-problem-1.purebasic

@@ -0,0 +1,32 @@
+EnableExplicit
+#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
+
+Procedure.s can_make_word(word.s)
+  Define.s letters = #LETTERS, buffer
+  Define.i index1, index2
+  Define.b match
+  For index1=1 To Len(word)
+    index2=1 : match=#False
+    Repeat
+      buffer=StringField(letters,index2,Space(1))
+      If FindString(buffer,Mid(word,index1,1),1,#PB_String_NoCase)
+        letters=RemoveString(letters,buffer+Chr(32),0,1,1)
+        match=#True
+        Break
+      EndIf
+      index2+1
+    Until index2>CountString(letters,Space(1))
+    If Not match : ProcedureReturn word+#TAB$+"FALSE" : EndIf
+  Next
+  ProcedureReturn word+#TAB$+"TRUE"
+EndProcedure
+
+OpenConsole()
+PrintN(can_make_word("a"))
+PrintN(can_make_word("BaRK"))
+PrintN(can_make_word("BOoK"))
+PrintN(can_make_word("TREAt"))
+PrintN(can_make_word("cOMMON"))
+PrintN(can_make_word("SqUAD"))
+PrintN(can_make_word("COnFUSE"))
+Input()

Task/ABC-Problem/PureBasic/abc-problem-2.purebasic

@@ -0,0 +1,21 @@
+Define.i
+#LETTERS = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM "
+
+Macro test(t)
+  Print(t+#TAB$+#TAB$+"= ") : If can_make_word(t) : PrintN("True") : Else : PrintN("False") : EndIf
+EndMacro
+
+Procedure.s residue(s$,n.i)
+  ProcedureReturn Left(s$,Int(n/3)*3)+Mid(s$,Int(n/3)*3+4)
+EndProcedure
+
+Procedure.b can_make_word(word$,letters$=#LETTERS)
+  n=FindString(letters$,Left(word$,1),1,#PB_String_NoCase)
+  If Len(word$) And n : ProcedureReturn can_make_word(Mid(word$,2),residue(letters$,n)) : EndIf
+  If Not Len(word$)   : ProcedureReturn #True : Else : ProcedureReturn #False           : EndIf
+EndProcedure
+
+OpenConsole()
+test("a")         : test("BaRK")      : test("BOoK")      : test("TREAt")
+test("cOMMON")    : test("SqUAD")     : test("COnFUSE")
+Input()

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

@@ -1,24 +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.*/
+/*REXX program determines if words can be spelt from a pool of toy blocks.    */
+list=  'A bark bOOk treat common squaD conFuse'   /*words can be in 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 a list of seven words*/
+          call  spell  word(list,k)    /*display if word can be spelt (or not)*/
+          end   /*k*/                  /* [↑]  tests each word in the list.   */
+exit                                   /*stick a fork in it,  we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+spell: procedure expose blocks;  arg x;  p.=0   /*uppercase word to be spelt. */
+parse upper var blocks theBlocks;  L=length(x)  /*uppercase the block letters.*/
+                                                /* [↓]  try to spell the word.*/
+  do try=1  for  L;   z=theBlocks               /*use a fresh copy of Z blocks*/
+    do n=1  for  L;   y=substr(x,n,1)           /*attempt another block letter*/
+    p.n=pos(y,z,1+p.n);  if p.n==0  then iterate try   /*not found? Try again.*/
+    z=overlay(' ',z,p.n)                        /*mutate block  ───►  a onesy.*/
+      do k=1  for words(blocks)                 /*scrub block pool  (not 1s). */
+      if length(word(z,k))==1  then z=delword(z,k,1)   /*single char?  Delete.*/
+      end   /*k*/                               /* [↑]  elide any onesy block.*/
+    if n==L  then leave try                     /*was the last letter spelt?  */
+    end     /*n*/                               /* [↑]  end of a block attempt*/
+  end       /*try*/                             /* [↑]  end of "TRY" permute. */
 
-say right(ox,30)   right(word("can't can", (n==L)+1),  6)      'be spelt.'
-return n==L                                     /*also, return the flag.*/
+say right(arg(1),30)    right(word("can't can", (n==L)+1), 6)        'be spelt.'
+return

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

@@ -1,33 +1,29 @@
-#![feature(core, unicode)]
-extern crate core;
-extern crate unicode;
-
-use core::iter::repeat;
-use core::str::StrExt;
-use unicode::char::CharExt;
+use std::iter::repeat;
 
 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
+    let c = word.chars().nth(index).unwrap().to_uppercase().next().unwrap();
+    for i in 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());
+    return rec_can_make_word(word.chars().count() - 1, word, blocks,
+                             &mut repeat(false).take(blocks.len()).collect::<Vec<_>>());
 }
 
 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()))
-	}
+    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 {
+        println!("{} -> {}", word, can_make_word(word, &blocks))
+    }
 }

Task/ABC-Problem/Scheme/abc-problem.ss

@@ -0,0 +1,41 @@
+(define *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 (exists p? li)
+  (and (not (null? li))
+       (or (p? (car li))
+           (exists p? (cdr li)))))
+
+(define (remove-one x li)
+  (cond
+    ((null? li) '())
+    ((equal? (car li) x) (cdr li))
+    (else (cons (car li) (remove-one x (cdr li))))))
+
+(define (can-make-list? li blocks)
+  (or (null? li)
+      (exists
+       (lambda (block)
+         (and
+          (member (char-upcase (car li)) block)
+          (can-make-list? (cdr li) (remove-one block blocks))))
+       blocks)))
+
+(define (can-make-word? word)
+  (can-make-list? (string->list word) *blocks*))
+
+
+(define *words*
+  '("A" "Bark" "book" "TrEaT" "COMMON" "squaD" "CONFUSE"))
+
+(for-each
+ (lambda (word)
+   (display (if (can-make-word? word)
+                "   Can make word: "
+                "Cannot make word: "))
+   (display word)
+   (newline))
+ *words*)