Hex words: Difference between revisions

</pre>

=={{header|Ada}}==

<syntaxhighlight lang="ada">

-- Hex Words: find words of 4 or more characters, all characters of which are hex digits

-- J. Carter 2024 May

with Ada.Characters.Handling;

with Ada.Containers.Vectors;

with Ada.Strings.Unbounded;

with Ada.Text_IO;

procedure Hex_Words is

use Ada.Strings.Unbounded;

subtype Hex_Digit is Character range 'a' .. 'f';

subtype Digit_Value is Integer range 0 .. 9;

function Hex_Word (Line : in String) return Boolean is

(Line'Length > 3 and (for all C of Line => C in Hex_Digit) );

function Digital_Root (Number : in Natural) return Digit_Value;

-- Returns the decimal digital root of Number

function Four_Distinct (Word : in String) return Boolean with

Pre => Hex_Word (Word);

-- Returns True if Word has at least 4 distinct letters; False otherwise

function Image (Number : in Natural) return String with

Post => Image'Result'Length = 9;

-- Returns the blank-filled decimal image of Number

type Word_Info is record

Word : Unbounded_String;

Value : Natural;

Root : Digit_Value;

end record;

function Root_Less (Left : in Word_Info; Right : in Word_Info) return Boolean is

(if Left.Root /= Right.Root then Left.Root < Right.Root else Left.Word < Right.Word);

function Value_Greater (Left : in Word_Info; Right : in Word_Info) return Boolean is

(if Left.Value /= Right.Value then Left.Value > Right.Value else Left.Word < Right.Word);

package Word_Lists is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Word_Info);

package Root_Sorting is new Word_Lists.Generic_Sorting ("<" => Root_Less);

package Value_Sorting is new Word_Lists.Generic_Sorting ("<" => Value_Greater);

function Digital_Root (Number : in Natural) return Digit_Value is

function Digit_Sum return Natural;

-- Sums the digits of the decimal representation of Number

function Digit_Sum return Natural is

Image : constant String := Number'Image;

Sum : Natural := 0;

begin -- Digit_Sum

All_Digits : for I in 2 .. Image'Last loop

Sum := Sum + Character'Pos (Image (I) ) - Character'Pos ('0');

end loop All_Digits;

return Sum;

end Digit_Sum;

Sum : Natural := Digit_Sum;

begin -- Digital_Root

if Sum in Digit_Value then

return Sum;

end if;

return Digital_Root (Sum);

end Digital_Root;

function Four_Distinct (Word : in String) return Boolean is

type Hex_Set is array (Hex_Digit) of Boolean;

Set : Hex_Set := (others => False);

Count : Natural := 0;

begin -- Four_Distinct

Check_All : for C of Word loop

Set (C) := True;

end loop Check_All;

Count_Them : for B of Set loop

if B then

Count := Count + 1;

end if;

end loop Count_Them;

return Count > 3;

end Four_Distinct;

function Image (Number : in Natural) return String is

Result : constant String := Number'Image;

begin -- Image

return (1 .. 9 - Result'Length => ' ') & Result;

end Image;

Input : Ada.Text_IO.File_Type;

Info : Word_Info;

Word : Word_Lists.Vector;

Distinct : Word_Lists.Vector;

begin -- Hex_Words

Ada.Text_IO.Open (File => Input, Mode => Ada.Text_IO.In_File, Name => "unixdict.txt");

All_Words : loop

exit All_Words when Ada.Text_IO.End_Of_File (Input);

One_Word : declare

Line : constant String := Ada.Characters.Handling.To_Lower (Ada.Text_IO.Get_Line (Input) );

begin -- One_Word

if Hex_Word (Line) then

Info.Word := To_Unbounded_String (Line);

Info.Value := Integer'Value ("16#" & Line & '#');

Info.Root := Digital_Root (Info.Value);

Word.Append (New_Item => Info);

if Four_Distinct (Line) then

Distinct.Append (New_Item => Info);

end if;

end if;

end One_Word;

end loop All_Words;

Ada.Text_IO.Close (File => Input);

Root_Sorting.Sort (Container => Word);

Value_Sorting.Sort (Container => Distinct);

Print_All : for I in 1 .. Word.Last_Index loop

Print_One : declare

Info : Word_Info renames Word.Element (I);

begin -- Print_One

Ada.Text_IO.Put_Line

(Item => To_String (Info.Word) & (1 .. 6 - Length (Info.Word) => ' ') & Image (Info.Value) & Info.Root'Image);

end Print_One;

end loop Print_All;

Ada.Text_IO.Put_Line (Item => Word.Last_Index'Image & " total words");

Ada.Text_IO.New_Line;

Output_Distinct : for I in 1 ..Distinct.Last_Index loop

One_Distinct : declare

Info : Word_Info renames Distinct.Element (I);

begin -- One_Distinct

Ada.Text_IO.Put_Line

(Item => To_String (Info.Word) & (1 .. 6 - Length (Info.Word) => ' ') & Image (Info.Value) & Info.Root'Image);

end One_Distinct;

end loop Output_Distinct;

Ada.Text_IO.Put_Line (Item => Distinct.Last_Index'Image & " words with 4 or more distinct letters");

end Hex_Words;

</syntaxhighlight>

{{out}}

<pre>

ababa 703162 1

abbe 43966 1

dada 56026 1

deaf 57007 1

decade 14600926 1

cede 52958 2

feed 65261 2

abed 44013 3

added 712173 3

bade 47838 3

beebe 782014 4

decca 912586 4

dade 56030 5

bead 48813 6

deface 14613198 6

babe 47806 7

fade 64222 7

dead 57005 8

efface 15727310 8

facade 16435934 8

accede 11325150 9

beef 48879 9

cafe 51966 9

dacca 896202 9

deed 57069 9

face 64206 9

26 total words

facade 16435934 8

efface 15727310 8

deface 14613198 6

decade 14600926 1

accede 11325150 9

decca 912586 4

fade 64222 7

face 64206 9

deaf 57007 1

cafe 51966 9

bead 48813 6

bade 47838 3

abed 44013 3

13 words with 4 or more distinct letters