67 lines
1.9 KiB
Text
67 lines
1.9 KiB
Text
/* 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;
|