-- 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;