Posted to tcl by philbr-t at Tue Mar 19 20:49:53 GMT 2024view raw

  1.  
  2. package require fileutil
  3.  
  4. # Benchmark showing the impact on lsearch in Tcl 8.6.11
  5. #
  6. # $ fossil info 26e57ca1486e497b
  7. # hash: 26e57ca1486e497b32e75a074c0ee81b62beefb8 2020-05-05 16:00:06 UTC
  8. # parent: 5d38a6b3c64572f808163ae7656333fea1e478a7 2020-05-05 15:56:14 UTC
  9. # child: b275de7c6434b50adf9f27ff24d01bd972efa624 2020-05-06 08:15:49 UTC
  10. # merged-into: b07935f03d33d1bdfb89a4b13f1fee914d78080d 2020-05-05 16:20:24 UTC
  11. # tags: core-8-6-branch
  12. # comment: More usage of TclUtfToUCS4(), so we can use the whole Unicode range better in TCL_UTF_MAX>3 builds. (user: jan.nijtmans)
  13.  
  14. #
  15. # $ /usr/local/tcl8.6.11/bin/tclsh8.6 lbench.tcl
  16. # stringlist has 5000 items.
  17. # lsearch returned -1 took 2297 microseconds.
  18. # lsearch -exact returned -1 took 23 microseconds.
  19. # $ /usr/local/tcl8.6.10/bin/tclsh8.6 lbench.tcl
  20. # stringlist has 5000 items.
  21. # lsearch returned -1 took 512 microseconds.
  22. # lsearch -exact returned -1 took 24 microseconds.
  23. #
  24. #
  25.  
  26. set alphabet [ list X M R 0 1 2 3 4 5 6 7 8 9 / ]
  27.  
  28. # based on suchenwi's random string generator from the Tcl Wiki:
  29. proc lpick L {lindex $L [expr {int(rand()*[llength $L])}]}
  30. proc randomlyPicked { length {chars { X 0 1 2 3 4 5 6 7 8 9 / }} } {
  31. for {set i 0} {$i<$length} {incr i} {append res [lpick $chars]}
  32. return $res
  33. }
  34.  
  35. set stringlist [ list ]
  36.  
  37. # Generate some repetitive random strings
  38. # Start all strings with a common prefix
  39. set string_prefix "X14/X33/X5/X1848/X1/X3/X1/X1/X1/X1/X8/X49/X34"
  40.  
  41. set numstrings 5000
  42.  
  43. for { set n 0 } { $n < $numstrings } { incr n } {
  44. set random_length [ expr { 5 + int(rand()*25) } ]
  45. set new_string "$string_prefix/[ randomlyPicked $random_length ]"
  46. lappend stringlist $new_string
  47. }
  48.  
  49. # Search for a unique string that also has the same common prefix
  50. set search_for "$string_prefix/M0"
  51. puts "stringlist has [ llength $stringlist ] items."
  52.  
  53. set timer [ clock microseconds ]
  54.  
  55. set finder [ lsearch $stringlist $search_for ]
  56.  
  57. puts "lsearch returned $finder took [ expr { [ clock microseconds ] - $timer } ] microseconds."
  58.  
  59. set timer [ clock microseconds ]
  60.  
  61. set finder [ lsearch -exact $stringlist $search_for ]
  62.  
  63. puts "lsearch -exact returned $finder took [ expr { [ clock microseconds ] - $timer } ] microseconds."