130 lines
3.0 KiB
Plaintext
130 lines
3.0 KiB
Plaintext
#Include "file.bi"
|
|
type tally
|
|
as string s
|
|
as long l
|
|
end type
|
|
|
|
Sub quicksort(array() As String,begin As Long,Finish As Long)
|
|
Dim As Long i=begin,j=finish
|
|
Dim As String x =array(((I+J)\2))
|
|
While I <= J
|
|
While array(I) < X :I+=1:Wend
|
|
While array(J) > X :J-=1:Wend
|
|
If I<=J Then Swap array(I),array(J): I+=1:J-=1
|
|
Wend
|
|
If J >begin Then quicksort(array(),begin,J)
|
|
If I <Finish Then quicksort(array(),I,Finish)
|
|
End Sub
|
|
|
|
Sub tallysort(array() As tally,begin As Long,Finish As long)
|
|
Dim As Long i=begin,j=finish
|
|
Dim As tally x =array(((I+J)\2))
|
|
While I <= J
|
|
While array(I).l > X .l:I+=1:Wend
|
|
While array(J).l < X .l:J-=1:Wend
|
|
If I<=J Then Swap array(I),array(J): I+=1:J-=1
|
|
Wend
|
|
If J >begin Then tallysort(array(),begin,J)
|
|
If I <Finish Then tallysort(array(),I,Finish)
|
|
End Sub
|
|
|
|
|
|
Function loadfile(file As String) As String
|
|
If Fileexists(file)=0 Then Print file;" not found":Sleep:End
|
|
Dim As Long f=Freefile
|
|
Open file For Binary Access Read As #f
|
|
Dim As String text
|
|
If Lof(f) > 0 Then
|
|
text = String(Lof(f), 0)
|
|
Get #f, , text
|
|
End If
|
|
Close #f
|
|
Return text
|
|
End Function
|
|
|
|
Function String_Split(s_in As String,chars As String,result() As String) As Long
|
|
Dim As Long ctr,ctr2,k,n,LC=Len(chars)
|
|
Dim As boolean tally(Len(s_in))
|
|
#macro check_instring()
|
|
n=0
|
|
While n<Lc
|
|
If chars[n]=s_in[k] Then
|
|
tally(k)=true
|
|
If (ctr2-1) Then ctr+=1
|
|
ctr2=0
|
|
Exit While
|
|
End If
|
|
n+=1
|
|
Wend
|
|
#endmacro
|
|
|
|
#macro splice()
|
|
If tally(k) Then
|
|
If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
|
|
ctr2=0
|
|
End If
|
|
#endmacro
|
|
'================== LOOP TWICE =======================
|
|
For k =0 To Len(s_in)-1
|
|
ctr2+=1:check_instring()
|
|
Next k
|
|
If ctr=0 Then
|
|
If Len(s_in) Andalso Instr(chars,Chr(s_in[0])) Then ctr=1':
|
|
End If
|
|
If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else Return 0
|
|
For k =0 To Len(s_in)-1
|
|
ctr2+=1:splice()
|
|
Next k
|
|
'===================== Last one ========================
|
|
If ctr2>0 Then
|
|
Redim Preserve result(1 To ctr+1)
|
|
result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
|
|
End If
|
|
|
|
Return Ubound(result)
|
|
End Function
|
|
|
|
Redim As String s()
|
|
redim as tally t()
|
|
dim as string p1,p2,deliminators
|
|
dim as long count,jmp
|
|
dim as double tm=timer
|
|
|
|
Var L=loadfile("rosettalesmiserables.txt")
|
|
L=lcase(L)
|
|
'get deliminators
|
|
for n as long=1 to 96
|
|
p1+=chr(n)
|
|
next
|
|
for n as long=123 to 255
|
|
p2+=chr(n)
|
|
next
|
|
|
|
deliminators=p1+p2
|
|
|
|
string_split(L,deliminators,s())
|
|
|
|
quicksort(s(),lbound(s),ubound(s))
|
|
|
|
For n As Long=lbound(s) To ubound(s)-1
|
|
if s(n+1)=s(n) then jmp+=1
|
|
if s(n+1)<>s(n) then
|
|
count+=1
|
|
redim preserve t(1 to count)
|
|
t(count).s=s(n)
|
|
t(count).l=jmp
|
|
jmp=0
|
|
end if
|
|
Next
|
|
|
|
tallysort(t(),lbound(t),ubound(t))'sort by frequency
|
|
print "frequency","word"
|
|
print
|
|
for n as long=lbound(t) to lbound(t)+9
|
|
print t(n).l,t(n).s
|
|
next
|
|
|
|
Print
|
|
print "time for operation ";timer-tm;" seconds"
|
|
sleep
|