::
x20_hist.ada
with Simple_io, Ada.Characters.Handling;
use Simple_io, Ada.Characters.Handling;
package Class_histogram is
type Histogram is private;
DEF_HEIGHT : CONSTANT Positive := 14;
procedure reset( the:in out Histogram );
procedure add_to( the:in out Histogram; a_ch:in Character );
procedure put(the:in Histogram; height:in Positive:=DEF_HEIGHT);
private
type Alphabet_index is new Character range 'A' .. 'Z';
subtype Alphabet_range is Alphabet_index;
type Alphabet_array is array (Alphabet_range) of Natural;
type Histogram is record
number_of : Alphabet_array := ( others => 0 );
end record;
end Class_histogram;
package body Class_histogram is
procedure reset(the:in out Histogram) is
begin
the.number_of := ( others => 0 ); -- Reset counts to 0
end reset;
procedure add_to(the:in out Histogram; a_ch:in Character) is
ch : Character;
begin
ch := a_ch; -- As write to ch
if is_lower(ch) then -- Convert to upper case
ch := to_upper( ch );
end if;
if is_upper( ch ) then -- so record
declare
c : Alphabet_index := Alphabet_index(ch);
begin
the.number_of(c) := the.number_of(c) + 1;
end;
end if;
end add_to;
procedure put(the:in Histogram;
height:in Positive:=DEF_HEIGHT) is
frequency : Alphabet_array; -- Copy to process
max_height : Natural := 0; -- Observed max
begin
frequency := the.number_of; -- Copy data (Array)
for ch in Alphabet_range loop -- Find max frequency
if frequency(ch) > max_height then
max_height:= frequency(ch);
end if;
end loop;
if max_height > 0 then
for ch in Alphabet_range loop -- Scale to max height
frequency(ch):=(frequency(ch)*height)/(max_height);
end loop;
end if;
for row in reverse 1 .. height loop -- Each line
put( " | " ); -- start of line
for ch in Alphabet_range loop
if frequency(ch) >= row then
put('*'); -- bar of hist >= col
else
put(' '); -- bar of hist < col
end if;
end loop;
put(" | "); new_line; -- end of line
end loop;
put(" +----------------------------+"); new_line;
put(" ABCDEFGHIJKLMNOPQRSTUVWXYZ " ); new_line;
put(" * = (approx) ");
put( Float(max_height) / Float(height), aft=>2, exp=>0 );
put(" characters "); new_line;
end put;
end Class_histogram;
with Simple_io, Class_histogram;
use Simple_io, Class_histogram;
procedure main is
ch:Character; -- Current character
text_histogram: Histogram; -- Histogram object
begin
reset(text_histogram); -- Reset to empty
while not end_of_file loop -- For each line
while not end_of_line loop -- For each character
get(ch); -- Get current character
add_to( text_histogram, ch ); -- Add to histogram
end loop;
skip_line; -- Next line
end loop;
put( text_histogram ); -- Print histogram
end main;
© M.A.Smith University of Brighton.
Created September 1995 last modified May 1997.
Comments, suggestions, etc.
M.A.Smith@brighton.ac.uk
*
[Home page]