RosettaCodeData/Task/Hex-words/XPL0/hex-words.xpl0
2024-10-16 18:07:41 -07:00

57 lines
2.2 KiB
Text

include xpllib; \for Sort
func DigRoot(N); \Return digital root of N
int N, S;
loop [S:= 0;
repeat N:= N/10;
S:= S + rem(0);
until N = 0;
if S < 10 then return S;
N:= S;
];
int Pass, I, J, K, Ch, Set, Distinct, Values(1000), N, DR;
char Word(25);
[FSet(FOpen("unixdict.txt", 0), ^I);
for Pass:= 1 to 2 do
[OpenI(3);
J:= 0;
repeat I:= 0; Set:= 0; Distinct:= 0;
loop [repeat Ch:= ChIn(3) until Ch # CR; \remove possible CR
if Ch=LF or Ch=EOF then
[if Pass=1 & I>=4 ! Pass=2 & Distinct>=4 then
[Word(I):= 0; \terminate string
OpenO(8);
Text(8, Word);
Values(J):= HexIn(8);
J:= J+1;
];
quit;
];
if Ch<^a or Ch>^f then \reject non-hex word
[repeat Ch:= ChIn(3) until Ch=LF or Ch=EOF;
quit;
];
if (Set & 1<<(Ch-^a)) = 0 then Distinct:= Distinct+1;
Set:= Set ! 1<<(Ch-^a);
Word(I):= Ch; \collect hex digits
I:= I+1;
];
until Ch = EOF;
if Pass = 2 then Sort(Values, J);
SetHexDigits(4);
for N:= 1 to 9 do \sort by digital root
[for K:= J-1 downto 0 do
[DR:= DigRoot(Values(K));
if Pass=1 & DR=N ! Pass=2 & N=1 then
[IntOut(0, DR); ChOut(0, Tab);
HexOut(0, Values(K)); ChOut(0, Tab);
IntOut(0, Values(K)); CrLf(0);
];
];
];
Text(0, "Total count: "); IntOut(0, J); CrLf(0);
CrLf(0);
];
]