HiSpeed WordCounter.

Share your advanced PureBasic knowledge/code with the community.
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

HiSpeed WordCounter.

Post by Flype »

Code updated for 5.20+

Code: Select all

;------------------------------------------------------
;- HiSpeed WordCounter for Purebasic 4.0
;- 
;- Written by comtois (2004), enhanced by flype (2006)
;------------------------------------------------------

EnableExplicit

Macro EnableGadgetRedraw(gadget, bool)
  SendMessage_(GadgetID(gadget), #WM_SETREDRAW, bool, #Null)
EndMacro

Structure NODE
  s.s     ; word
  n.i     ; counter
  *l.NODE ; left node
  *r.NODE ; right node
EndStructure

Procedure Node(*node.NODE, word.s)
  If *node
    If word = *node\s
      *node\n + 1
    ElseIf word < *node\s
      *node\l = Node(*node\l, word)
    Else
      *node\r = Node(*node\r, word)
    EndIf
  Else
    *node = AllocateMemory(SizeOf(NODE))
    If *node
      *node\s = word
      *node\n = 1
    EndIf
  EndIf
  ProcedureReturn *node
EndProcedure

Procedure.s FileToString(fichier.s)
  Protected texte.s
  If ReadFile(0, fichier)
    texte = Space(Lof(0))
    ReadData(0, @texte, Lof(0))
    CloseFile(0)
  EndIf
  ProcedureReturn texte
EndProcedure

Procedure Process(string.s, minimum)
  Protected *node, word.s, length, *str.Byte = @string
  While *str\b
    Select *str\b
      Case ' ', '.', ',', ';', ' ', '(', ')', '[', ']', '"', ':', '=', '^', 39, #TAB, #CR, #LF
        If length >= minimum
          *node = Node(*node, word)
        EndIf
        word = ""
        length = 0
      Default
        word + Chr(*str\b)
        length + 1
    EndSelect
    *str + 1
  Wend
  ProcedureReturn *node
EndProcedure

Procedure.s NodesToString(*node.NODE, minimum)
  Protected result.s
  If *node
    result + NodesToString(*node\l, minimum)
    If *node\n >= minimum
      result + RSet(Str(*node\n), 3, "0") + " : " + *node\s + #CRLF$
    EndIf
    result + NodesToString(*node\r, minimum)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s NodesToList(*node.NODE, List myList.NODE())
  If *node
    NodesToList(*node\l, myList())
    If AddElement(myList())
      myList()\s = *node\s
      myList()\n = *node\n
    EndIf
    NodesToList(*node\r, myList())
  EndIf
EndProcedure

Procedure.s NodesToListIcon(*node.NODE, minimum)
  If *node
    NodesToListIcon(*node\l, minimum)
    If *node\n >= minimum
      AddGadgetItem(0, -1, *node\s + #LF$ + Str(*node\n))
    EndIf
    NodesToListIcon(*node\r, minimum)
  EndIf
EndProcedure

;------------------------------------------------------
;- TEST
;------------------------------------------------------

#EXAMPLE = 3

Define WordLength   = 1
Define WordCount    = 1
;Define.s WordFileName = #PB_Compiler_Home + "Compilers/PBFunctionListing.txt"
Define.s WordFileName = #PB_Compiler_Home + "Compilers/APIFunctionListing.txt"

Select #EXAMPLE
  
  Case 1 ; Nodes To String
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
      EditorGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10)
      EnableGadgetRedraw(0, #False)
      SetGadgetText(0, NodesToString(Process(FileToString(WordFileName), WordLength), WordCount))
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
  Case 2 ; Nodes To ListIconGadget
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
      ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
      EnableGadgetRedraw(0, #False)
      NodesToListIcon(Process(FileToString(WordFileName), WordLength), WordCount)
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
  Case 3 ; Nodes To List To ListIconGadget
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered)
      ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
      EnableGadgetRedraw(0, #False)
      NewList SortedList.NODE()
      NodesToList(Process(FileToString(WordFileName), WordLength), SortedList())
      SortStructuredList(SortedList(), 1, OffsetOf(NODE\n), #PB_Long)
      ForEach SortedList()
        AddGadgetItem(0, -1, SortedList()\s + #LF$ + Str(SortedList()\n))
      Next
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
EndSelect

;------------------------------------------------------
Last edited by Flype on Wed Jul 12, 2006 9:55 am, edited 2 times in total.
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Post by Comtois »

---------------------------
PureBasic
---------------------------
Ligne 32: With 'EnableExplicit', variables have to be declared: node
---------------------------
OK
---------------------------
try to post again with Disable html
Please correct my english
http://purebasic.developpez.com/
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

thank you comtois, you're true - it works better when disabling HTML .

first post modified:
1/ so now it's ok.
2/ display results in a listicongadget
3/ it also works when unicode compiler directive is activated.

This line in the Process() function :

Case ' ', '.', ',', ';', ' ', '(', ')', '[', ']', '"', ':', '=', '^', 39, #TAB, #CR, #LF

is the line you might modify to fit with your needs.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Post Reply