Rosetta Code

Hex words: Difference between revisions

Page Discussion

Hex words (view source)

Revision as of 12:05, 27 May 2024

15,745 bytes added ,  30 days ago
Added Ada version
No edit summary
(Added Ada version)
 
(7 intermediate revisions by 5 users not shown)
Line 87:
9 face 64206
Total count of those words: 13
</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
</pre>
 
Line 764 ⟶ 962:
Found 13 hex words with 4 or more distinct
</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> INSTALL @lib$ + "SORTLIB"
sort%=FN_sortinit(0, 0)
 
DIM Result$(127)
*LOWERCASE ON
F%=OPENIN(@dir$ + "unixdict.txt")
WHILE TRUE
W$=GET$#F%
IF W$ < "g" ELSE EXIT WHILE
IF LENW$ > 3 IF INSTR(W$, "o") == 0 THEN
D%=EVAL("&" + W$)
IF LENW$ == LEN(STR$~D%) THEN
REPEAT
E%=0
WHILE D% > 0 E%+=D% MOD 10 D%/=10 ENDWHILE
D%=E%
UNTIL D% < 10
Result$(C%)=STR$D% + W$
C%+=1
ENDIF
ENDIF
ENDWHILE
CLOSE#F%
 
CALL sort%, Result$(0)
PRINT "Root Word Base 10"
FOR I%=0 TO C% - 1
W$=MID$(Result$(I%), 2)
PRINT " " LEFT$(Result$(I%), 1) " " W$ TAB(13) EVAL("&" + W$)
E%=0
FOR J%=ASC"a" TO ASC"f"
IF INSTR(W$, CHR$J%) E%+=1
NEXT
IF E% > 3 THEN
Result$(I%)="z" + STR$LENResult$(I%) + W$ + LEFT$(Result$(I%), 1)
N%+=1
ENDIF
NEXT
PRINT "Total: ";C% '
 
CALL sort%, Result$(0)
PRINT "Root Word Base 10"
FOR I%=C% - 1 TO C% - N% STEP -1
W$=LEFT$(MID$(Result$(I%), 3))
PRINT " " RIGHT$(Result$(I%)) " " W$ TAB(13) EVAL("&" + W$)
NEXT
PRINT "Total: ";N%</syntaxhighlight>
{{out}}
<pre>Root Word Base 10
1 ababa 703162
1 abbe 43966
1 dada 56026
1 deaf 57007
1 decade 14600926
2 cede 52958
2 feed 65261
3 abed 44013
3 added 712173
3 bade 47838
4 beebe 782014
4 decca 912586
5 dade 56030
6 bead 48813
6 deface 14613198
7 babe 47806
7 fade 64222
8 dead 57005
8 efface 15727310
8 facade 16435934
9 accede 11325150
9 beef 48879
9 cafe 51966
9 dacca 896202
9 deed 57069
9 face 64206
Total: 26
 
Root Word Base 10
8 facade 16435934
8 efface 15727310
6 deface 14613198
1 decade 14600926
9 accede 11325150
4 decca 912586
7 fade 64222
9 face 64206
1 deaf 57007
9 cafe 51966
6 bead 48813
3 bade 47838
3 abed 44013
Total: 13</pre>
 
=={{header|C++}}==
Line 960 ⟶ 1,253:
13 such words found which contain 4 or more different digits.
</pre>
 
 
=={{header|FutureBasic}}==
Line 1,441 ⟶ 1,733:
9 face 64206
Total count of those words: 13.
</pre>
 
=={{header|MiniScript}}==
This implementation is for use with the [http://miniscript.org/MiniMicro Mini Micro] version of MiniScript. The command-line version does not include a HTTP library. Modify the declaration of wordList object to use the file class instead of the http class. The script already includes this line; just change which line is commented out and ensure the dictionary file is on the local filesystem.
<syntaxhighlight lang="miniscript">
pad = function(n, width, rightJustify = false)
if rightJustify then
s = (" " * width + n)[-width:]
else
s = (n + " " * width)[:width]
end if
return s
end function
 
getDigitalRoot = function(n)
while floor(log(n)) > 0
sum = 0
while n > 0
sum += n % 10
n = floor(n / 10)
end while
n = sum
end while
return sum
end function
 
hexToDec = function(hex)
digits = "0123456789abcdef"
result = digits.indexOf(hex[0])
for hdigit in hex[1:]
result *= 16
result += digits.indexOf(hdigit)
end for
return result
end function
 
isHexWord = function(word)
for ch in word.split("")
if "abcdef".indexOf(ch) == null then return false
end for
return true
end function
 
distinctLetters = function(word)
letters = {}
for ch in word.split("")
letters[ch] = 1
end for
return letters.indexes
end function
 
wordList = http.get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").split(char(10))
//wordList = file.readLines("unixdict.txt")
 
hexWords = []
for word in wordList
if word.len > 3 and isHexWord(word) then hexWords.push word
end for
 
roots = []
for hex in hexWords
decimal = hexToDec(hex)
root = getDigitalRoot(decimal)
roots.push [root, hex, decimal]
end for
roots.sort(0)
 
print "Hex words in unixdict.txt:"
print pad("Root", 6) + pad("Word",10) + "Base 10"
print "-" * 23
for root in roots
print pad(root[0],6) + pad(root[1],7) + pad(root[2],9,true)
end for
print "Total count of words: " + roots.len
 
cnt = 0
print
print "Hext words with > 3 distinct letters:"
print pad("Root", 6) + pad("Word",10) + "Base 10"
print "-" * 23
for root in roots
if distinctLetters(root[1]).len > 3 then
cnt += 1
print pad(root[0],6) + pad(root[1],7) + pad(root[2],9,true)
end if
end for
print "Total count of these words: " + cnt
</syntaxhighlight>
 
{{out}}
<pre>Hex words in unixdict.txt:
Root Word Base 10
-----------------------
1 ababa 703162
1 abbe 43966
1 dada 56026
1 deaf 57007
1 decade 14600926
2 cede 52958
2 feed 65261
3 abed 44013
3 added 712173
3 bade 47838
4 beebe 782014
4 decca 912586
5 dade 56030
6 bead 48813
6 deface 14613198
7 babe 47806
7 fade 64222
8 dead 57005
8 efface 15727310
8 facade 16435934
9 accede 11325150
9 beef 48879
9 cafe 51966
9 dacca 896202
9 deed 57069
9 face 64206
Total count of words: 26
 
Hext words with > 3 distinct letters:
Root Word Base 10
-----------------------
1 deaf 57007
1 decade 14600926
3 abed 44013
3 bade 47838
4 decca 912586
6 bead 48813
6 deface 14613198
7 fade 64222
8 efface 15727310
8 facade 16435934
9 accede 11325150
9 cafe 51966
9 face 64206
Total count of these words: 13
</pre>
 
Line 1,698 ⟶ 2,129:
 
Total count: 13
</pre>
 
=={{header|Pascal}}==
==={{header|Free Pascal}}===
<syntaxhighlight lang="pascal">
{$mode ObjFPC}{$H+}
uses
strutils, classes, sysutils;
 
const
FNAME = 'unixdict.txt';
 
type
PRec = ^TRec;
TRec = record
Root: Uint32;
Base10: UInt32;
Hex: String;
end;
 
TRecList = TList;
 
function DigitalRoot(n: UInt32): UInt32;
{returns the digital root}
begin
if n < 10 then
Result := n
else
Result := DigitalRoot(n div 10 + n mod 10);
end;
 
function IsHexWord(const str: string): Boolean;
{returns TRUE if string is a hexword}
var
ch: Char;
begin
for ch in str do
if not (ch in ['a', 'b', 'c', 'd', 'e', 'f']) then
Exit(FALSE);
Result := TRUE;
end;
 
function Has4Distinctive(const str: string): Boolean;
{returns TRUE if string contains 4 or more distinctive charachters}
var
arr: array['a'..'f'] of Boolean;
ch: Char;
counter: Integer;
begin
for ch := 'a' to 'f' do
arr[ch] := FALSE;
counter := 0;
for ch in str do
if not arr[ch] then
begin
arr[ch] := TRUE;
Inc(counter);
if counter = 4 then
Exit(TRUE);
end;
Result := FALSE;
end;
 
procedure PurgeRecList(var list: TRecList);
{remove every record that doesn have atleast 4 distinctive charachters}
var
rec: PRec;
i: Integer;
begin
for i := Pred(list.Count) downto 0 do
begin
rec := list[i];
if not Has4Distinctive(rec^.Hex) then
list.Delete(i);
end;
end;
 
procedure CreateRecList(var reclist: TRecList; list: TStringList);
{create list of records that have 4 or more charachters and are hexwords}
var
str: string;
aPrec: PRec;
begin
for str in list do
if (Length(str) > 3) and IsHexWord(str) then
begin
New(aPrec);
aPrec^.Base10 := Hex2Dec(str);
aPrec^.Root := DigitalRoot(aPrec^.Base10);
aPrec^.Hex := str;
reclist.Add(aPrec);
end;
end;
 
function SortOnRoot(Item1, Item2: Pointer): Integer;
{sort the list on Root}
begin
Result := PRec(Item1)^.Root - PRec(Item2)^.Root;
end;
 
function SortOnBase10(Item1, Item2: Pointer): Integer;
{sort the list on Base 10}
begin
Result := PRec(Item2)^.Base10 - PRec(Item1)^.Base10;
end;
 
procedure PrintList(list: TRecList);
var
rec: PRec;
begin
Writeln('Root':4, 'Base 10':10, 'Hex Word':10);
for rec in list do
Writeln(rec^.Root:4, rec^.Base10:10, rec^.Hex:10);
Writeln('Total Count:', list.Count);
Writeln;
end;
 
var
list: TStringList;
RecList: TRecList;
 
begin
list := TStringList.Create;
list.LoadFromFile(FNAME);
RecList := TRecList.Create;
CreateRecList(RecList, list); {create list of records purging first set}
list.Free; {no longer need for the dictionary}
RecList.Sort(@SortOnRoot); {sort list on the root}
PrintList(RecList); {print the list}
PurgeRecList(RecList); {purge list second set}
RecList.Sort(@SortOnBase10); {sort on base 10}
PrintList(RecList); {print the list}
RecList.Free; {free the memory}
end.
 
</syntaxhighlight>
{{out}}
<pre>
Root Base 10 Hex Word
1 14600926 decade
1 56026 dada
1 57007 deaf
1 703162 ababa
1 43966 abbe
2 65261 feed
2 52958 cede
3 712173 added
3 44013 abed
3 47838 bade
4 782014 beebe
4 912586 decca
5 56030 dade
6 48813 bead
6 14613198 deface
7 64222 fade
7 47806 babe
8 15727310 efface
8 57005 dead
8 16435934 facade
9 64206 face
9 48879 beef
9 11325150 accede
9 51966 cafe
9 57069 deed
9 896202 dacca
Total Count:26
 
Root Base 10 Hex Word
8 16435934 facade
8 15727310 efface
6 14613198 deface
1 14600926 decade
9 11325150 accede
4 912586 decca
7 64222 fade
9 64206 face
1 57007 deaf
9 51966 cafe
6 48813 bead
3 47838 bade
3 44013 abed
Total Count:13
</pre>
 
Line 2,025 ⟶ 2,638:
=={{header|Raku}}==
Sorted by digital root with a secondary alphabetical sort.
<syntaxhighlight lang="raku" line>sub dr (Int $_ is copy) { $_ = dr(.comb.sum) while .chars > 1; $_ }
 
my %hex = './unixdict.txt'.IO.slurp.words.grep( *.chars > 3 )\
Line 2,434 ⟶ 3,047:
{{libheader|Wren-math}}
{{libheader|Wren-seq}}
<syntaxhighlight lang="ecmascriptwren">import "./ioutil" for FileUtil
import "./fmt" for Conv, Fmt
import "./math" for Int
Jrcarter
34

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/355173...364777"