Data commit

Task/Anagrams/PL-I/anagrams.pli

@@ -0,0 +1,67 @@
+/* Search a list of words, finding those having the same letters. */
+
+word_test: proc options (main);
+   declare words (50000) character (20) varying,
+           frequency (50000) fixed binary;
+   declare word character (20) varying;
+   declare (i, k, wp, most) fixed binary (31);
+
+   on endfile (sysin) go to done;
+
+   words = ''; frequency = 0;
+   wp = 0;
+   do forever;
+      get edit (word) (L);
+      call search_word_list (word);
+   end;
+
+done:
+   put skip list ('There are ' || wp || ' words');
+   most = 0;
+   /* Determine the word(s) having the greatest number of anagrams. */
+   do i = 1 to wp;
+      if most < frequency(i) then most = frequency(i);
+   end;
+   put skip edit ('The following word(s) have ', trim(most), ' anagrams:') (a);
+   put skip;
+   do i = 1 to wp;
+      if most = frequency(i) then put edit (words(i)) (x(1), a);
+   end;
+
+search_word_list: procedure (word) options (reorder);
+   declare word character (*) varying;
+   declare i fixed binary (31);
+
+   do i = 1 to wp;
+      if length(words(i)) = length(word) then
+         if is_anagram(word, words(i)) then
+            do;
+               frequency(i) = frequency(i) + 1;
+               return;
+            end;
+   end;
+   /* The word does not exist in the list, so add it. */
+   if wp >= hbound(words,1) then return;
+   wp = wp + 1;
+   words(wp) = word;
+   frequency(wp) = 1;
+   return;
+end search_word_list;
+
+/* Returns true if the words are anagrams, otherwise returns false. */
+is_anagram: procedure (word1, word2) returns (bit(1)) options (reorder);
+   declare (word1, word2) character (*) varying;
+   declare tword character (20) varying, c character (1);
+   declare (i, j) fixed binary;
+
+   tword = word2;
+   do i = 1 to length(word1);
+      c = substr(word1, i, 1);
+      j = index(tword, c);
+      if j = 0 then return ('0'b);
+      substr(tword, j, 1) = ' ';
+   end;
+   return ('1'b);
+end is_anagram;
+
+end word_test;