Tcl Source Code

Artifact f31b7b40345dcd4a8487b8bbceb74f21ee8befcc:

Attachment "benchmark_no_f.tcl" to ticket [3380073fff] added by andreas_kupries 2011-07-29 22:23:52.

---

package require math::statistics

namespace eval ::benchmark {
	namespace path {::tcl::mathop ::math::statistics}

	# Functional sugar <<<
	proc lforeach args {
		set loop_control	[lrange $args 0 end-1]
		set body			[list uplevel 1 [lindex $args end]]
		foreach vars [list {*}[dict keys $loop_control]] {
			foreach var $vars {
				upvar 1 $var $var
			}
		}
		set out	{}
		foreach {*}$loop_control {
			# try is an 8.6 thing :(
			#try $body on ok res {lappend out $res}
			if {![catch $body res]} {lappend out $res}
		}
		set out
	}

	proc lmap {list func} {
		set out	{}
		foreach e $list {
			lappend out [uplevel 1 [list {*}$func $e]]
		}
		set out
	}

	proc iota1 n {
		set out	{}
		for {set i 1} {$i <= $n} {incr i} {lappend out $i}
		set out
	}
	# Functional sugar >>>

	proc test {it_a it_b units args} { #<<<
		switch -- $units {
			usec	{set div 1}
			ms		{set div 1000.0}
			default	{error "Unsupported units: \"$units\""}
		}
		puts "\n== testing proc ($args) ====="
		set i		0
		set rtimes	{}
		#set it		500000
		set it		[* $it_a $it_b]
		set start	[clock microseconds]
		while {[incr i] <= $it_a} {
			set j	0
			lappend rtimes	[clock microseconds]
			while {[incr j] <= $it_b} {
				{*}$args
			}
			lappend rtimes	[clock microseconds]
		}
		set runtime	[- [clock microseconds] $start]
		set _a	[clock microseconds]
		set times	[lforeach {a b} $rtimes {expr {double($b - $a) / ($it_b * $div)}}]
		puts [format "munge times: %.3f ms" [/ [- [clock microseconds] $_a] 1000.0]]
		puts "llength times: [llength $times]"
		set vars {
			arithmetic_mean min max number_of_data
			sample_stddev sample_var
			population_stddev population_var
		}
		lassign [basic-stats $times] {*}$vars
		set median	[median $times]
		set harmonic_mean	0
		foreach time $times {
			set harmonic_mean	[+ $harmonic_mean [/ 1.0 $time]]
		}
		set harmonic_mean	[/ [llength $times] $harmonic_mean]
		puts "descriptive parameters:"
		set pvars {
			min
			median
			harmonic_mean
			arithmetic_mean
			max
			sample_stddev
		}
		set it		[* [llength $times] $it_b]
		#set unitspi	[/ [+ {*}$times] $it]
		set unitspi	$median
		set ips		[/ [* 1000000.0 $it] $runtime]
		set max_pvar_len	[tcl::mathfunc::max {*}[lmap $pvars {string length}]]
		foreach var $pvars {
			puts [format "\t%${max_pvar_len}s: %7.3f %s" $var [set $var] $units]
		}
		puts [format "%.3f %s per iteration / %.3f iterations per second ($it iterations in %.3f seconds)" $unitspi $units $ips [/ $runtime 1000000.0]]
		set hist_buckets	10
		set interval_size	[expr {
			$population_stddev * 2.0 / $hist_buckets
		}]
		set intervals	[list [+ $min [* $interval_size 0.1]]]
		set interval	[+ $min $interval_size]
		lappend intervals	{*}[lforeach i [iota1 $hist_buckets] {set interval [+ $interval $interval_size]}]
		set histogram	[histogram $intervals $times]
		set max_hist	[tcl::mathfunc::max {*}$histogram]
		foreach interval $intervals hist $histogram {
			puts [format [expr {$interval ne "" ? "<= %10.6f %6d %s" : "   %10s %6d %s"}]\
					$interval \
					$hist \
					[string repeat # [expr {round(($hist * 50.0) / $max_hist)}]] \
			]
		}
	}

	#>>>
}

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4