Posted to tcl by dandyn at Sun Nov 24 20:49:38 GMT 2024view raw

  1. namespace import ::tcl::prefix
  2. set histBuf {trump Trump trump Trump apple trump trumps apple trumps trump trumps trump hello hello hello hello helloo apple helloo helloo}
  3. proc wordcount {nr} {
  4. global histBuf
  5. unset -nocomplain data tmp result word
  6. set data [lrange $histBuf end-$nr end]
  7.  
  8.  
  9. foreach word [regexp -all -inline {\w+} $data] {
  10.  
  11. if {$word in "trumps helloo"} {
  12. switch [prefix match {trumps helloo} $word] {
  13. trumps {incr tmp([string tolower trump]) ; continue}
  14. helloo {incr tmp([string tolower hello]) ; continue}
  15. }
  16. }
  17. incr tmp([string tolower $word])
  18. }
  19.  
  20. # make a list of array..
  21. set result [array get tmp]
  22.  
  23. # First sort by name, as a secondary key
  24. set result [lsort -stride 2 -index 0 $result]
  25. # Then sort by count, descending, as a primary key
  26. set result [lsort -stride 2 -index 1 -integer -decreasing $result]
  27.  
  28. set exclude {
  29. after with that from says over more about will have said their
  30. this they been were into what could first some used than
  31. till lokalt efter säger inte från under vill flera blir alla vara
  32. blev fick över kommer nytt just direkt
  33. mycket måste därför ingen hela utan bakom stora bara igen eller andra allt
  34. aldrig bättre rätt description
  35. }
  36.  
  37. # Print the values
  38. puts "\n[string repeat "=" 3] \[STATS\] [string repeat "=" 23]"
  39.  
  40. foreach {w c} $result {
  41.  
  42. # word must be at minimum 4 chars long
  43. if {![regexp {^\w{4,}$} $w]} {continue}
  44. # word must accur at least this many times or more
  45. if {$c <= 2} {continue}
  46. if {[regexp $w $exclude match]} {continue}
  47.  
  48. puts [string repeat " " 4][format "%-10s = %s" $w $c]
  49. }
  50. puts "[string repeat "=" 24]"
  51. puts "Last $nr posts..\n"
  52. }
  53.  
  54. wordcount 20

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week