-- Unique words:
-- Input: One "word" per line (here, a "word" can contain blanks)
-- Output: Each unique "word" and the number of times it appears
with ada.text_io; use ada.text_io;
with ada.integer_text_io; use ada.integer_text_io;
procedure unique is
----------------------------------------------
-- A type for strings with a bounded length (ie 0 to 80 characters)
----------------------------------------------
subtype Word_Length is Natural range 0 .. 80;
type Word is record
s: String(1 .. Word_Length'last);
len: Word_Length;
end record;
function "="(left, right: Word) return Boolean is
-- An expression function that checks length first.
-- Checking length explicitly is no necessary
(left.len = right.len and then left.s(1 .. left.len) = right.s(1 .. right.len));
-- begin
-- return left.s(1 .. left.len) = right.s(1 .. right.len);
-- end "=";
procedure getw(w: out Word) is
begin
get_line(w.s, w.len);
-- Reads an entire line and sets w.len to the number of characters read
end getw;
procedure putw(w: in Word) is
begin
put(w.s (1 .. w.len));
-- Output just the slice
end putw;
----------------------------------------------
-- A type for a Word and its frequency
----------------------------------------------
type Word_Freq is record
w: Word;
Count: Natural; -- Frequency count
end record;
-- Increase the frequency count by one
procedure inc(wf: in out Word_Freq) is
begin
wf.Count := wf.Count + 1;
end inc;
procedure getwf(wf: out Word_Freq) is
begin
getw(wf.w);
wf.count := 1;
-- Initial frequency count is one
end getwf;
procedure putwf(wf: in Word_Freq) is
begin
putw(wf.w);
put(wf.count);
end putwf;
----------------------------------------------
-- A bounded array whose elements are Word_Freqs
----------------------------------------------
type Word_Freq_Array is array(1 .. 200) of Word_Freq;
type Word_Freq_List is record
w_freqs: Word_Freq_Array;
num: Natural range 0 .. Word_Freq_Array'last := 0;
-- Iniitially the list contains no elements, so num is 0
end record;
-- Store Word_Freq wf in Word_Freq_List wfl and
-- increase the count of the number of elements in the list
procedure add(wf: Word_Freq; wfl: in out Word_Freq_List) is
begin
wfl.num := wfl.num + 1;
wfl.w_freqs(wfl.num) := wf;
end add;
------------------------------------------------------
-- If wf is already in wfl, increase the frequency
-- If wf is not already in wfl, add it (with frequency 1)
------------------------------------------------------
procedure count_or_add(wf: Word_Freq; wfl: in out Word_Freq_List) is
found: Boolean := false;
loc: Natural := 1; -- Element of list to try
begin
while not found and loc <= wfl.num loop
if wf.w = wfl.w_freqs(loc).w then -- Check word at loc
found := true; -- Found it
else
loc := loc + 1; -- Not found, so move to next element
end if;
end loop;
-- Loop condition false, so: found xor i > wfl.num
if found then
inc(wfl.w_freqs(loc)); -- Increase the count
else
-- Loc > num. Is it also < array size?
if loc < wfl.w_freqs'last then -- Is there room to add?
add(wf, wfl); -- Yes, so add it
else -- No, so error
raise Constraint_Error with "Too many words";
end if;
end if;
end count_or_add;
-- Print the Word_Freqs that have been stored in the list wfl
procedure put(wfl: in Word_Freq_List) is
begin
-- Iterator loop of a slice
for wf of wfl.w_freqs(1 .. wfl.num) loop
-- TO shorten output, print only Word_Freqs that occur more than once
if wf.count > 1 then
putwf(wf);
new_line;
end if;
-- Alternate loop with explicit index i
-- for i in 1 .. wfl.num loop
-- putwf(wfl.w_freqs(i));
-- end loop
end loop;
end put;
-- aword: Word; -- This was for testing only
awordf: Word_Freq;
awfl: Word_Freq_List;
begin
-- Input each word and add it to list if new and count if unique
while not end_of_file loop
getwf(awordf);
count_or_add(awordf, awfl);
-- add(awordf, awfl); -- This was for testing only
-- putwf(awordf); -- This was for testing only
end loop;
-- Print all words in the list
put(awfl);
end unique;