151 lines
4.3 KiB
Plaintext
151 lines
4.3 KiB
Plaintext
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
|