Another update from ingydotnet^djgoku

2015-11-18 06:14:39 +00:00 · 2015-11-18 06:14:39 +00:00 · 948b86eafa
commit 948b86eafa
parent 91df62d461
7604 changed files with 108452 additions and 22726 deletions
--- a/Task/ABC-Problem/ALGOL-W/abc-problem.alg
+++ b/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.