aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2024-10-16 18:07:41 -07:00
parent 81fd053722
commit 52a6ef48dd
10248 changed files with 63654 additions and 6775 deletions
Download patch file Download diff file Expand all files Collapse all files

195
Task/Hex-words/ALGOL-68/hex-words.alg
View file

@ -1,77 +1,62 @@
# find words that contain only hex digits a-f #
IF FILE input file;
STRING file name = "unixdict.txt";
open( input file, file name, stand in channel ) /= 0
THEN
# failed to open the file #
print( ( "Unable to open """ + file name + """", newline ) )
ELSE
# file opened OK #
BOOL at eof := FALSE;
# set the EOF handler for the file #
on logical file end( input file, ( REF FILE f )BOOL:
BEGIN
# note that we reached EOF on the #
# latest read #
at eof := TRUE;
# return TRUE so processing can continue #
TRUE
END
);
INT count := 0;
INT max words = 100; # guess at the maximum number of words #
MODE HEXWORD = STRUCT( STRING word, LONG INT value, INT root, INT len );
BEGIN # find words with 4 or more characters that contain only hex digits a-f #
PR read "files.incl.a68" PR # include file utilities #
INT max words = 100; # guess at the maximum number of words #
MODE HEXWORD = STRUCT( STRING word, LONG INT value, INT root, INT len );
[ 1 : max words ]HEXWORD hw;
WHILE STRING word;
get( input file, ( word, newline ) );
NOT at eof
DO
# check the word contains only a-f and compute its decimal value #
IF INT word len = ( UPB word + 1 ) - LWB word;
word len >= 4
THEN
# the word is at least 4 characters long #
BOOL is hex word := word /= "";
LONG INT int word := 0;
# returns TRUE if word is a hex-word ( contains only a-f and is at least #
# four characters long, FALSE otherwise #
# if word is a hex-word, it is stored in the hw table #
# count so far contains the count of preceding hex-words #
PROC find hex words = ( STRING word, INT count so far )BOOL:
IF INT word len = ( UPB word + 1 ) - LWB word;
word len < 4
THEN FALSE # word is too short#
ELSE # word is at least 4 characters long #
BOOL is hex word := word /= "";
LONG INT int word := 0;
FOR i FROM LWB word TO UPB word
WHILE is hex word := word[ i ] >= "a" AND word[ i ] <= "f"
DO
int word *:= 16;
int word +:= ( ABS word[ i ] - ABS "a" ) + 10
OD;
IF is hex word
THEN
# have a hex word #
count +:= 1;
# compute the digital root #
LONG INT r := int word;
IF NOT is hex word
THEN FALSE # not a hex word #
ELSE # have a hex word #
LONG INT r := int word; # compute the digital root #
WHILE r > 9 DO
LONG INT dr := r MOD 10;
WHILE ( r OVERAB 10 ) > 0 DO dr +:= r MOD 10 OD;
r := dr
OD;
word OF hw[ count ] := word;
value OF hw[ count ] := int word;
root OF hw[ count ] := SHORTEN r;
len OF hw[ count ] := word len
INT hw pos = count so far + 1;
word OF hw[ hw pos ] := word;
value OF hw[ hw pos ] := int word;
root OF hw[ hw pos ] := SHORTEN r;
len OF hw[ hw pos ] := word len;
TRUE
FI
FI
OD;
close( input file );
# prints the HEXWORD hw #
PROC show = ( HEXWORD hw )VOID:
BEGIN
STRING pad = IF len OF hw >= 12 THEN "" ELSE ( 12 - len OF hw ) * " " FI;
print( ( word OF hw, ": ", pad, whole( value OF hw, -10 ), " [ ", whole( root OF hw, 0 ), " ]", newline ) )
END # show # ;
# Quicksorts in-place the array of HEXWORDS a, from lb to ub on ascending value #
PROC quicksort = ( REF[]HEXWORD a, INT lb, ub )VOID:
IF ub > lb THEN
# more than one element, so must sort #
INT left := lb;
INT right := ub;
# choosing the middle element of the array as the pivot #
LONG INT pivot := value OF a[ left + ( ( right + 1 ) - left ) OVER 2 ];
FI # find hex words # ;
# prints the HEXWORD hw #
PROC show hex word = ( HEXWORD hword )VOID:
BEGIN
print( ( word OF hword, ": " ) );
TO 12 - len OF hword DO print( ( " " ) ) OD;
print( ( whole( value OF hword, -10 ) ) );
print( ( " [ ", whole( root OF hword, 0 ), " ]", newline ) )
END # show hex word # ;
# Quicksorts in-place the array of HEXWORDS a, from lb to ub #
# on ascending value #
PROC quicksort hw = ( REF[]HEXWORD a, INT lb, ub )VOID:
IF ub > lb THEN # more than one element, so must sort #
INT left := lb;
INT right := ub;
# choosing the middle element of the array as the pivot #
LONG INT pivot := value OF a[ left + ( ( right + 1 ) - left ) OVER 2 ];
WHILE
WHILE IF left <= ub THEN value OF a[ left ] < pivot ELSE FALSE FI DO left +:= 1 OD;
WHILE IF right >= lb THEN value OF a[ right ] > pivot ELSE FALSE FI DO right -:= 1 OD;
@ -83,43 +68,51 @@ ELSE
left +:= 1;
right -:= 1
OD;
quicksort( a, lb, right );
quicksort( a, left, ub )
FI # quicksort # ;
# show the hex words in ascending order of digital root #
FOR r FROM 1 TO 9 DO
FOR i FROM 1 TO count DO
IF root OF hw[ i ] = r THEN show( hw[ i ] ) FI
OD
OD;
print( ( "Found ", whole( count, 0 ), " hex words", newline, newline ) );
# show the words in descending value order excluding those with less than 4 unique letters #
quicksort( hw, 1, count );
INT count 4 := 0;
FOR i FROM count BY -1 TO 1 DO
# check the word has at least four different digits #
INT a := 0, b := 0, c := 0, d := 0, e := 0, f := 0;
FOR c pos FROM LWB word OF hw[ i ] TO UPB word OF hw[ i ] DO
IF CHAR ch = ( word OF hw[ i ] )[ c pos ];
ch = "a"
THEN a := 1
ELIF ch = "b"
THEN b := 1
ELIF ch = "c"
THEN c := 1
ELIF ch = "d"
THEN d := 1
ELIF ch = "e"
THEN e := 1
ELSE f := 1
FI
OD;
IF a + b + c + d + e + f >= 4
THEN
# have a hex word with at least 4 different digits #
count 4 +:= 1;
show( hw[ i ] )
FI
OD;
print( ( "Found ", whole( count 4, 0 ), " hex words with 4 or more distinct digits", newline ) )
FI
quicksort hw( a, lb, right );
quicksort hw( a, left, ub )
FI # quicksort hw # ;
# load hw with the hex-words from unixdict.txt #
IF INT count = "unixdict.txt" EACHLINE find hex words;
count < 0
THEN print( ( "Unable to open unixdict.txt", newline ) )
ELSE # show the hex words in ascending order of digital root #
FOR r FROM 1 TO 9 DO
FOR i FROM 1 TO count DO
IF root OF hw[ i ] = r THEN show hex word( hw[ i ] ) FI
OD
OD;
print( ( "Found ", whole( count, 0 ), " hex words", newline, newline ) );
# show the words in descending value order excluding those with less #
# than 4 unique letters #
quicksort hw( hw, 1, count );
INT count 4 := 0;
FOR i FROM count BY -1 TO 1 DO
# check the word has at least four different digits #
INT a := 0, b := 0, c := 0, d := 0, e := 0, f := 0;
FOR c pos FROM LWB word OF hw[ i ] TO UPB word OF hw[ i ] DO
IF CHAR ch = ( word OF hw[ i ] )[ c pos ];
ch = "a"
THEN a := 1
ELIF ch = "b"
THEN b := 1
ELIF ch = "c"
THEN c := 1
ELIF ch = "d"
THEN d := 1
ELIF ch = "e"
THEN e := 1
ELSE f := 1
FI
OD;
IF a + b + c + d + e + f >= 4
THEN # have a hex word with at least 4 different digits #
count 4 +:= 1;
show hex word( hw[ i ] )
FI
OD;
print( ( "Found ", whole( count 4, 0 ) ) );
print( ( " hex words with 4 or more distinct digits", newline ) )
FI
END

93
Task/Hex-words/EasyLang/hex-words.easy Normal file
View file

@ -0,0 +1,93 @@
func ishex w$ .
c$ = ""
for c$ in strchars w$
h = strcode c$
if h < 97 or h > 102
break 1
.
.
return if c$ = ""
.
global w$[] part2 .
func digsum num .
while num > 0
s += num mod 10
num = num div 10
.
return s
.
func digroot x .
while x > 9
x = digsum x
.
return x
.
func dec w$ .
for c$ in strchars w$
r = r * 16 + strcode c$ - 87
.
return r
.
func comp a$ b$ .
if part2 = 1
return if dec a$ > dec b$
.
return if digroot dec a$ < digroot dec b$
.
proc sort . .
for i = len w$[] - 1 downto 1
for j = 1 to i
if comp w$[j] w$[j + 1] = 1
swap w$[j] w$[j + 1]
.
.
.
.
proc init . .
repeat
s$ = input
until s$ = ""
if len s$ >= 4 and ishex s$ = 1
w$[] &= s$
.
.
.
init
sort
proc show . .
for w$ in w$[]
w = dec w$
print digroot w & " " & w$ & " " & w
.
print len w$[] & " words"
print ""
.
show
#
func dist w$ .
len d[] 6
for c$ in strchars w$
d[strcode c$ - 96] = 1
.
for e in d[]
s += e
.
return s
.
for w$ in w$[]
if dist w$ > 3
w2$[] &= w$
.
.
swap w$[] w2$[]
part2 = 1
sort
show
#
# the content of unixdict.txt
input_data
10th
ababa
beebe
decade
facade

150
Task/Hex-words/FreeBASIC/hex-words.basic Normal file
View file

@ -0,0 +1,150 @@
Function DigitalRoot(n As Integer) As Integer
While n > 9
Dim s As String = Str(n)
n = 0
For i As Integer = 1 To Len(s)
n += Val(Mid(s, i, 1))
Next
Wend
Return n
End Function
Sub BubbleSort(arr() As String)
For i As Integer = 1 To Ubound(arr) - 1
For j As Integer = 1 To Ubound(arr) - i - 1
If arr(j) > arr(j + 1) Then Swap arr(j), arr(j + 1)
Next
Next
End Sub
Sub ReadLines(filename As String, lines() As String)
Open filename For Input As #1
Dim linea As String
Dim lineCount As Integer = 0
Do While Not Eof(1)
Line Input #1, linea
lineCount += 1
Redim Preserve lines(lineCount)
lines(lineCount - 1) = linea
Loop
Close #1
End Sub
Sub FilterWords(lines() As String, words() As String)
Dim As Integer i, j
Dim wordCount As Integer = 0
For i = 0 To Ubound(lines)
Dim w As String = Trim(lines(i))
If Len(w) >= 4 Then
Dim valid As Boolean = True
For j = 1 To Len(w)
If Instr("abcdef", Mid(w, j, 1)) = 0 Then
valid = False
Exit For
End If
Next
If valid Then
wordCount += 1
Redim Preserve words(wordCount)
words(wordCount - 1) = w
End If
End If
Next
End Sub
Sub CalculateResults(words() As String, results() As String)
Dim resultCount As Integer = 0
For i As Integer = 0 To Ubound(words)-1
Dim w As String = words(i)
Dim base10 As Integer = Val("&H" & w)
Dim root As Integer = DigitalRoot(base10)
resultCount += 1
Redim Preserve results(resultCount)
results(resultCount - 1) = Str(root) & " " & w & " " & Str(base10)
Next
End Sub
Sub PrintResults(results() As String, title As String)
Dim As Integer i, j
Print title
Print "Root Word Base 10"
Print String(23, "-")
BubbleSort(results())
For i = 0 To Ubound(results) -1
Dim parts() As String
Dim part As String = ""
Dim partIndex As Integer = 0
For j = 1 To Len(results(i))
If Mid(results(i), j, 1) = " " Then
partIndex += 1
Redim Preserve parts(partIndex)
parts(partIndex - 1) = part
part = ""
Else
part &= Mid(results(i), j, 1)
End If
Next
partIndex += 1
Redim Preserve parts(partIndex)
parts(partIndex - 1) = part
Print Using "## \ \ ########"; Val(parts(0)); parts(1); Val(parts(2))
Next
Print "Total count of these words: "; Ubound(results)
End Sub
Sub FilterDistinctLetters(results() As String, filteredResults() As String)
Dim As Integer i, j
Dim filteredCount As Integer = 0
For i = 0 To Ubound(results)
Dim parts() As String
Dim part As String = ""
Dim partIndex As Integer = 0
For j = 1 To Len(results(i))
If Mid(results(i), j, 1) = " " Then
partIndex += 1
Redim Preserve parts(partIndex)
parts(partIndex - 1) = part
part = ""
Else
part &= Mid(results(i), j, 1)
End If
Next
partIndex += 1
Redim Preserve parts(partIndex)
parts(partIndex - 1) = part
Dim w As String = parts(1)
If Len(w) > 3 Then
Dim distinct As String = ""
For j = 1 To Len(w)
If Instr(distinct, Mid(w, j, 1)) = 0 Then
distinct &= Mid(w, j, 1)
End If
Next
If Len(distinct) > 3 Then
filteredCount += 1
Redim Preserve filteredResults(filteredCount)
filteredResults(filteredCount - 1) = results(i)
End If
End If
Next
End Sub
Dim lines() As String
Dim words() As String
Dim results() As String
Dim filteredResults() As String
' Main program
ReadLines("unixdict.txt", lines())
FilterWords(lines(), words())
CalculateResults(words(), results())
PrintResults(results(), "Hex words in unixdict.txt:")
Print
FilterDistinctLetters(results(), filteredResults())
PrintResults(filteredResults(), "Hex words with > 3 distinct letters:")
Sleep

0
Task/Hex-words/Julia/hex-words.julia → Task/Hex-words/Julia/hex-words.jl
View file

16
Task/Hex-words/Nu/hex-words.nu Normal file
View file

@ -0,0 +1,16 @@
def make-row [n] {
{word: $in decimal: $n dr: (($n - 1) mod 9 + 1)}
}
def fmt-table [] {
$"($in | table -i false -t compact)total count: ($in | length)\n"
}
open 'unixdict.txt' | split words -l 4
| where $it =~ '(?i)^[A-F]+$'
| each { make-row ($in | into int -r 16) }
| [
($in | sort-by dr)
($in | where ($it.word | split chars | uniq | length) > 3 | sort-by -r decimal)
]
| each { fmt-table } | str join "\n"

87
Task/Hex-words/OmniMark/hex-words.xom Normal file
View file

@ -0,0 +1,87 @@
global integer word-root variable
global integer word-dec variable
global stream dec-word variable
define integer function digroot (value stream vs) as
local integer d initial {vs base 16}
local integer r initial {0}
set new word-dec key vs to d
repeat
repeat scan '%d(d)'
match digit => add
set r to r + add
again
exit when r < 10
set d to r
set r to 0
again
return r
define switch function isword4-bool (value stream vs) as
local stream s variable
repeat scan vs
match letter => char
set new s key char to char unless s has key char
again
return true when number of s > 3
return false
process
submit file 'unixdict.txt'
find line-start (['a' to 'f']{4}['a' to 'f']*) => word line-end
set new word-root key word to digroot(word)
find any
process-end
local integer c initial {1}
output '====== REPORT 1 ======%n' ||
'Hex words with:%n(1) 4+ letters%n(2) Ascending (digit root)%n' ||
'======================%nRoot Word Decimal%n----------------------%n'
repeat
exit when c = 10
repeat over word-root
do when word-root = c
output '%6fd(word-root)' || '8fg' % key of word-root ||
'd' % word-dec key (key of word-root) || '%n'
done
again
increment c
again
set c to number of word-root
output '%nTotal word count: ' || 'd' % c || '%n'
output '%n%n====== REPORT 2 ======%n' ||
'Hex words with:%n(1) 4+ distinct letters%n(2) Descending (decimal)%n' ||
'======================%nDecimal Word Root%n----------------------%n'
set c to 1
repeat over word-dec
do when number of dec-word = 0
set new dec-word key '%d(word-dec)' to key of word-dec
else when number of dec-word = 1
do when word-dec < key of dec-word[1]
set new dec-word key '%d(word-dec)' after [1] to key of word-dec
else
set new dec-word key '%d(word-dec)' before [1] to key of word-dec
done
else when number of dec-word > 1
repeat over dec-word
do when word-dec < key of dec-word
increment c
else
exit
done
again
set new dec-word key '%d(word-dec)' before [c] to key of word-dec
set c to 1
done
again
set c to 0
repeat over dec-word
do when isword4-bool(dec-word)
increment c
output '10fd' % key of dec-word || '%8fg(dec-word)' ||
'd' % word-root key dec-word || '%n'
done
again
output '%nTotal word count: ' || 'd' % c || '%n'

57
Task/Hex-words/XPL0/hex-words.xpl0 Normal file
View file

@ -0,0 +1,57 @@
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);
];
]