Posted to tcl by hypnotoad at Thu May 11 11:31:43 GMT 2017view raw

  1. proc foreach* {args} {
  2. set script [lindex $args end]
  3. set args [lrange $args 0 end-1]
  4. set dictval [concat {*}[lmap {k _} $args {string cat "[list $k] \[set [list $k]\]"}]]
  5. set script "set values \[dict create $dictval\]\n $script"
  6. foreach {b a} [lreverse $args] {
  7. set script [list foreach $a $b $script]
  8. }
  9. tailcall {*}$script
  10. }
  11.  
  12. proc permutation {combinations body {valuevar values} {values {}} {level 0}} {
  13. incr level
  14. set final 1
  15. foreach {field valuelist} $combinations {
  16. if {[dict exists $values $field]} continue
  17. set final 0
  18. if {[llength $valuelist]==0} {
  19. dict set values $field {}
  20. permutation $combinations $body $valuevar $values $level
  21. } else {
  22. foreach value $valuelist {
  23. dict set values $field $value
  24. permutation $combinations $body $valuevar $values $level
  25. }
  26. }
  27. return
  28. }
  29. uplevel $level [list set $valuevar $values]
  30. uplevel $level [list dict with $valuevar {}]
  31. uplevel $level $body
  32. }
  33.  
  34. set DATASET {
  35. compartment {5compt}
  36. generator {one two three}
  37. switchboard {one two three}
  38. }
  39. # Shimmer DATASET to be a list
  40. llength $DATASET
  41.  
  42. set trial 0
  43. set start [clock clicks]
  44. permutation $DATASET {
  45. set permutation_clicks([incr trial]) [expr {[clock clicks]-$start}]
  46. }
  47. parray permutation_clicks
  48.  
  49. set trial 0
  50. set start [clock clicks]
  51. foreach* {*}$DATASET {
  52. set foreach*_clicks([incr trial]) [expr {[clock clicks]-$start}]
  53. }
  54. parray foreach*_clicks
  55.  
  56. set DATASET {
  57. compartment {5compt 8compt}
  58. generator {one two three}
  59. switchboard {one two three}
  60. cwplant {single double}
  61. cwloop {single portstarb foraft psfa}
  62. }
  63. # Shimmer DATASET to be a list
  64. llength $DATASET
  65.  
  66. puts "BIGGER DATASET"
  67. set trial 0
  68. set start [clock clicks]
  69. permutation $DATASET {
  70. set permutation_clicks([incr trial]) [expr {[clock clicks]-$start}]
  71. }
  72. parray permutation_clicks
  73.  
  74. set trial 0
  75. set start [clock clicks]
  76. foreach* {*}$DATASET {
  77. set foreach*_clicks([incr trial]) [expr {[clock clicks]-$start}]
  78. }
  79. parray foreach*_clicks