Isograms and heterograms: Difference between revisions

=={{header|ALGOL 68}}==

<lang algol68># find some isograms ( words where each letter occurs the same number of #

# times as the others ) and heterograms ( words where each letter occurs #

# once ). Note a heterogram is an isogram of order 1 #

IF FILE input file;

STRING file name = "unixdict.txt";

open( input file, file name, stand in channel ) /= 0

THEN

# failed to open the file #

print( ( "Unable to open """ + file name + """", newline ) )

ELSE

# file opened OK #

BOOL at eof := FALSE;

# set the EOF handler for the file #

on logical file end( input file

, ( REF FILE f )BOOL:

BEGIN # note that we reached EOF on the latest read #

# and return TRUE so processing can continue #

at eof := TRUE

END

);

# in-place quick sort an array of strings #

PROC s quicksort = ( REF[]STRING a, INT lb, ub )VOID:

IF ub > lb

THEN

# more than one element, so must sort #

INT left := lb;

INT right := ub;

# choosing the middle element of the array as the pivot #

STRING pivot := a[ left + ( ( right + 1 ) - left ) OVER 2 ];

WHILE

WHILE IF left <= ub THEN a[ left ] < pivot ELSE FALSE FI

DO

left +:= 1

OD;

WHILE IF right >= lb THEN a[ right ] > pivot ELSE FALSE FI

DO

right -:= 1

OD;

left <= right

DO

STRING t := a[ left ];

a[ left ] := a[ right ];

a[ right ] := t;

left +:= 1;

right -:= 1

OD;

s quicksort( a, lb, right );

s quicksort( a, left, ub )

FI # s quicksort # ;

# returns the length of s #

OP LENGTH = ( STRING s )INT: 1 + ( UPB s - LWB s );

# returns n if s is an isogram of order n, 0 if s is not an isogram #

OP ORDER = ( STRING s )INT:

BEGIN

# count the number of times each character occurs #

[ 0 : max abs char ]INT count;

FOR i FROM LWB count TO UPB count DO count[ i ] := 0 OD;

FOR i FROM LWB s TO UPB s DO

CHAR c = s[ i ];

IF c >= "A" AND c <= "Z" THEN

# uppercase - treat as lower #

count[ ( ABS c - ABS "A" ) + ABS "a" ] +:= 1

ELSE

# lowercase or non-letter #

count[ ABS c ] +:= 1

FI

OD;

INT order := -1;

# check the characters all occur the same number of times #

FOR i FROM LWB count TO UPB count WHILE order /= 0 DO

IF count[ i ] /= 0 THEN

# have a characetr that appeared in s #

IF order = -1 THEN

# first character #

order := count[ i ]

ELIF order /= count[ i ] THEN

# character occured a different number of times to #

# the previous one #

order := 0

FI

FI

OD;

IF order < 0 THEN 0 ELSE order FI

END # ORDER # ;

[ 1 : 2 000 ]STRING words;

INT w count := 0;

WHILE NOT at eof

DO

STRING word;

get( input file, ( word, newline ) );

IF NOT at eof THEN

# have another word #

INT order = ORDER word;

IF order > 0 THEN

INT w length = LENGTH word;

IF ( order = 1 AND w length > 10 ) OR order > 1 THEN

# a long heterogram or an isogram #

# store the word prefixed by the max abs char complement #

# of the order and the length so when sorted, the words #

# are ordered as requierd by the task #

STRING s word = REPR ( max abs char - order )

+ REPR ( max abs char - w length )

+ word;

words[ w count +:= 1 ] := s word

FI

FI

FI

OD;

close( input file );

# sort the words #

s quicksort( words, 1, w count );

# display the words #

INT prev order := 0;

INT prev length := 999 999;

INT p count := 0;

FOR w TO w count DO

STRING gram = words[ w ];

INT order = max abs char - ABS gram[ 1 ];

INT length = max abs char - ABS gram[ 2 ];

STRING word = gram[ 3 : ];

IF order /= prev order THEN

IF order = 1 THEN

print( ( newline, "heterograms longer than 10 characters" ) )

ELSE

print( ( newline, "isograms of order ", whole( order, 0 ) )

)

FI;

prev order := order;

prev length := 999 999;

p count := 0

FI;

IF prev length > length OR p count > 5 THEN

print( ( newline ) );

prev length := length;

p count := 0

FI;

print( ( " " * IF length > 11 THEN 1 ELSE 13 - length FI, word ) );

p count +:= 1

OD

FI

</lang>

{{out}}

<pre>

isograms of order 3

aaa iii

isograms of order 2

beriberi bilabial caucasus couscous teammate

appall emmett hannah murmur tartar testes

anna coco dada deed dodo gogo

isis juju lulu mimi noon otto

papa peep poop teet tete toot

tutu

ii

heterograms longer than 10 characters

ambidextrous bluestocking exclusionary incomputable lexicography loudspeaking

malnourished

atmospheric blameworthy centrifugal christendom consumptive countervail

countryside countrywide disturbance documentary earthmoving exculpatory

geophysical inscrutable misanthrope problematic selfadjoint stenography

sulfonamide switchblade switchboard switzerland thunderclap valedictory

voluntarism

</pre>