Posted to tcl by pooryorick at Fri Oct 14 02:30:33 GMT 2016view raw

  1. namespace import ::tcl::mathfunc::round
  2. package require struct::list
  3.  
  4. package require struct::set
  5.  
  6.  
  7. proc + {a b} {expr {$a + $b}}
  8. proc benchmark { {cmd1 cmd1} {cmd2 cmd2} {times 1000} {n1 "Command 1"} {n2 "Command 2"} } {
  9. set result "
  10. Benchmark:
  11. ------------------
  12.  
  13. $n1:
  14. [info body $cmd1]
  15.  
  16. $n2:
  17. [info body $cmd2]
  18.  
  19. Results:
  20. ------------------
  21. "
  22.  
  23. set r0 [time {set times} 1000]
  24.  
  25. set r1 [lindex [ time $cmd1 $times ] 0]
  26. set r2 [lindex [ time $cmd2 $times ] 0]
  27. set r3 [lindex [ time $cmd2 $times ] 0]
  28. set r4 [lindex [ time $cmd1 $times ] 0]
  29. set r5 [lindex [ time $cmd1 $times ] 0]
  30. set r6 [lindex [ time $cmd2 $times ] 0]
  31. set r7 [lindex [ time $cmd1 $times ] 0]
  32. set r8 [lindex [ time $cmd2 $times ] 0]
  33.  
  34. set r0 [lindex [ time $cmd1 1000 ] 0]
  35. set r0 [lindex [ time $cmd2 1000 ] 0]
  36.  
  37. set 1 [list $r1 $r4 $r5 $r7]
  38. set 2 [list $r2 $r3 $r6 $r8]
  39.  
  40. set 1sum [::struct::list fold $1 0 +]
  41. set 2sum [::struct::list fold $2 0 +]
  42. set 1avg [round [expr { $1sum / [llength $1] }]]
  43. set 2avg [round [expr { $2sum / [llength $2] }]]
  44.  
  45. set iterations1 [expr { $times * [llength $1] }]
  46. set iterations2 [expr { $times * [llength $2] }]
  47. set fsum1 [expr { $1avg * $iterations1 }]
  48. set fsum2 [expr { $2avg * $iterations2 }]
  49. set fsum1ms [expr { round($fsum1 / 1000) }]
  50. set fsum2ms [expr { round($fsum2 / 1000) }]
  51. append result "\n Tests:
  52. $n1 : $1
  53. $n2 : $2
  54. "
  55. append result "\n Summary:
  56. Average: $1avg vs $2avg
  57. Duration (MS): $fsum1ms vs $fsum2ms
  58. Duration (Micro): $fsum1 vs $fsum2
  59. "
  60.  
  61.  
  62. if { $1avg > $2avg } {
  63. set by [expr { $1avg - $2avg }]
  64. set winner "2"
  65. set win $2avg
  66. set lose [expr {$1avg + .0000000000001}]
  67. set name $n2
  68. } else {
  69. set winner "1"
  70. set win $1avg
  71. set lose [expr {$2avg + .0000000000001}]
  72. set by [expr { $2avg - $1avg }]
  73. set name $n1
  74. }
  75. set pct [expr { ( 1 - ( double($win) / $lose ) ) * 100 }]
  76. set sum [expr { round( ($by * $iterations1) / 1000 )}]
  77. append result "\n\n
  78. Winner: Command $winner (${name})
  79. Iterations: $iterations1
  80. Wins By: $by microseconds per iteration
  81. Overall Faster By: $sum milliseconds
  82. Faster by %: $pct
  83.  
  84. ------------------
  85. "
  86.  
  87. puts $result
  88.  
  89. puts [expr { $1sum }]
  90. return [list $winner $sum]
  91. }
  92.  
  93.  
  94.  
  95. proc cmd1 {} {
  96. for {set i 0} {$i < 10000} {incr i} {
  97. incr a
  98. }
  99. }
  100.  
  101. proc cmd2 {} {
  102. for {set i 0} {$i < 10000} {incr i} {
  103. incr a
  104. }
  105. }
  106.  
  107. b