Posted to tcl by alan at Tue May 19 19:48:24 GMT 2026view raw

  1. #!/usr/bin/env tclsh
  2. # =============================================================================
  3. # dict_update_native_vs_custom_new.tcl
  4. #
  5. # Benchmark: native "dict update" vs custom dict_update proc
  6. #
  7. # The custom proc generalises "dict update" to support nested key paths via
  8. # a dynamic keyList argument (using {*}$keyList expansion).
  9. #
  10. # Setup:
  11. # - A dict of N=1000 keys, each holding a list of M=100000 elements.
  12. #
  13. # Scenarios:
  14. # 1. lset  replace element at index j=50000 in list at key i=500
  15. # 2. lappend  append a new element to the list at key i=500
  16. #
  17. # Each scenario is profiled with: profile {demo_<name> ...} $iter
  18. # profile discards the first run (warmup); dict is recreated before each call
  19. # =============================================================================
  20.  
  21. # ---------------------------------------------------------------------------
  22. # Custom dict_update proc (from spec  unchanged)
  23. # ---------------------------------------------------------------------------
  24. proc dict_update {dictObjVar keyList entryVar script} {
  25. upvar $dictObjVar dictObj
  26. upvar $entryVar entry
  27. try {
  28. set entry [dict get $dictObj {*}$keyList]
  29. dict set dictObj {*}$keyList {}
  30. uplevel $script
  31. } finally {
  32. dict set dictObj {*}$keyList $entry
  33. }
  34. }
  35.  
  36. # ---------------------------------------------------------------------------
  37. # Configuration
  38. # ---------------------------------------------------------------------------
  39. set N 1000 ;# number of dict keys
  40. set M 100000 ;# number of elements per list value
  41. set iter 50 ;# iterations passed to [time]
  42.  
  43. set demo_i 500 ;# key to operate on
  44. set demo_j 50000 ;# list index to modify in the lset scenario
  45.  
  46. # ---------------------------------------------------------------------------
  47. # make_dict  build and return a fresh dict
  48. # ---------------------------------------------------------------------------
  49. proc make_dict {} {
  50. global N M
  51. set d {}
  52. for {set i 0} {$i < $N} {incr i} {
  53. dict set d $i [lrepeat $M 0]
  54. }
  55. return $d
  56. }
  57.  
  58. # ---------------------------------------------------------------------------
  59. # profile  discard first run, recreate dict before timing, then time
  60. # ---------------------------------------------------------------------------
  61. proc profile {cmd n} {
  62. uplevel 1 $cmd ;# warmup (uses current benchDict)
  63. uplevel 1 [list time $cmd $n]
  64. }
  65.  
  66. # ---------------------------------------------------------------------------
  67. # Demo procs  lset (replace element at index j)
  68. # ---------------------------------------------------------------------------
  69. proc demo_native_lset {benchDict demo_i demo_j} {
  70. upvar 1 $benchDict myDict
  71. dict update myDict $demo_i entry {
  72. lset entry $demo_j 1
  73. }
  74. }
  75.  
  76. proc demo_custom_lset {benchDict demo_i demo_j} {
  77. upvar 1 $benchDict myDict
  78. dict_update myDict [list $demo_i] entry {
  79. lset entry $demo_j 1
  80. }
  81. }
  82.  
  83. # ---------------------------------------------------------------------------
  84. # Demo procs  lappend (append new element to the list)
  85. # ---------------------------------------------------------------------------
  86. proc demo_native_lappend {benchDict demo_i} {
  87. upvar 1 $benchDict myDict
  88. dict update myDict $demo_i entry {
  89. lappend entry newElem
  90. }
  91. }
  92.  
  93. proc demo_custom_lappend {benchDict demo_i} {
  94. upvar 1 $benchDict myDict
  95. dict_update myDict [list $demo_i] entry {
  96. lappend entry newElem
  97. }
  98. }
  99.  
  100. # ---------------------------------------------------------------------------
  101. # Benchmarks
  102. # ---------------------------------------------------------------------------
  103. proc print_result {label t} {
  104. puts [format " %-30s %s" "$label:" $t]
  105. }
  106.  
  107. puts "=== Scenario 1: lset (key=$demo_i, index=$demo_j) ==="
  108. set benchDict [make_dict]
  109. print_result "native dict update" [profile {demo_native_lset benchDict $demo_i $demo_j} $iter]
  110. puts "updated value: [lindex [dict get $benchDict $demo_i] $demo_j]"
  111. set benchDict [make_dict]
  112. print_result "custom dict_update" [profile {demo_custom_lset benchDict $demo_i $demo_j} $iter]
  113. puts "updated value: [lindex [dict get $benchDict $demo_i] $demo_j]"
  114.  
  115. puts ""
  116. puts "=== Scenario 2: lappend (key=$demo_i) ==="
  117. set benchDict [make_dict]
  118. print_result "native dict update" [profile {demo_native_lappend benchDict $demo_i} $iter]
  119. puts "updated value llength: [llength [dict get $benchDict $demo_i]]"
  120. set benchDict [make_dict]
  121. print_result "custom dict_update" [profile {demo_custom_lappend benchDict $demo_i} $iter]
  122. puts "updated value llength: [llength [dict get $benchDict $demo_i]]"
  123.  

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