Source code in the freebasic programming language

 #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 
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 
 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
        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