Hex words: Difference between revisions

4,031 bytes added ,  1 month ago
no edit summary
No edit summary
No edit summary
 
(3 intermediate revisions by 2 users not shown)
Line 1,055:
13 such words found which contain 4 or more different digits.
</pre>
 
 
=={{header|FutureBasic}}==
Line 1,932 ⟶ 1,931:
 
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,668 ⟶ 2,849:
{{libheader|Wren-math}}
{{libheader|Wren-seq}}
<syntaxhighlight lang="ecmascriptwren">import "./ioutil" for FileUtil
import "./fmt" for Conv, Fmt
import "./math" for Int
43

edits