tasks a-s

Task/Numeric-error-propagation/Tcl/numeric-error-propagation-1.tcl

@@ -0,0 +1,54 @@
+package require Tcl 8.6
+oo::class create RAII-support {
+    constructor {} {
+	upvar 1 { end } end
+	lappend end [self]
+	trace add variable end unset [namespace code {my DieNicely}]
+    }
+    destructor {
+	catch {
+	    upvar 1 { end } end
+	    trace remove variable end unset [namespace code {my DieNicely}]
+	}
+    }
+    method return {{level 1}} {
+	incr level
+	upvar 1 { end } end
+	upvar $level { end } parent
+	trace remove variable end unset [namespace code {my DieNicely}]
+	lappend parent [self]
+	trace add variable parent unset [namespace code {my DieNicely}]
+	return -level $level [self]
+    }
+    # Swallows arguments
+    method DieNicely args {tailcall my destroy}
+}
+oo::class create RAII-class {
+    superclass oo::class
+    method return args {
+	[my new {*}$args] return 2
+    }
+    method unknown {m args} {
+	if {[string is double -strict $m]} {
+	    return [tailcall my new $m {*}$args]
+	}
+	next $m {*}$args
+    }
+    unexport create unknown
+    self method create args {
+	set c [next {*}$args]
+	oo::define $c superclass {*}[info class superclass $c] RAII-support
+	return $c
+    }
+}
+# Makes a convenient scope for limiting RAII lifetimes
+proc scope {script} {
+    foreach v [info global] {
+	if {[array exists ::$v] || [string match { * } $v]} continue
+	lappend vars $v
+	lappend vals [set ::$v]
+    }
+    tailcall apply [list $vars [list \
+	try $script on ok msg {$msg return}
+    ] [uplevel 1 {namespace current}]] {*}$vals
+}

Task/Numeric-error-propagation/Tcl/numeric-error-propagation-2.tcl

@@ -0,0 +1,51 @@
+RAII-class create Err {
+    variable N E
+    constructor {number {error 0.0}} {
+	next
+	namespace import ::tcl::mathfunc::* ::tcl::mathop::*
+	variable N $number E [abs $error]
+    }
+    method p {} {
+	return "$N \u00b1 $E"
+    }
+
+    method n {} { return $N }
+    method e {} { return $E }
+
+    method + e {
+	if {[info object isa object $e]} {
+	    Err return [+ $N [$e n]] [hypot $E [$e e]]
+	} else {
+	    Err return [+ $N $e] $E
+	}
+    }
+    method - e {
+	if {[info object isa object $e]} {
+	    Err return [- $N [$e n]] [hypot $E [$e e]]
+	} else {
+	    Err return [- $N $e] $E
+	}
+    }
+    method * e {
+	if {[info object isa object $e]} {
+	    set f [* $n [$E n]]
+	    Err return $f [expr {hypot($E*$f/$N, [$e e]*$f/[$e n])}]
+	} else {
+	    Err return [* $N $e] [abs [* $E $e]]
+	}
+    }
+    method / e {
+	if {[info object isa object $e]} {
+	    set f [/ $n [$E n]]
+	    Err return $f [expr {hypot($E*$f/$N, [$e e]*$f/[$e n])}]
+	} else {
+	    Err return [/ $N $e] [abs [/ $E $e]]
+	}
+    }
+    method ** c {
+	set f [** $N $c]
+	Err return $f [abs [* $f $c [/ $E $N]]]
+    }
+
+    export + - * / **
+}

Task/Numeric-error-propagation/Tcl/numeric-error-propagation-3.tcl

@@ -0,0 +1,9 @@
+set x1 [Err 100 1.1]
+set x2 [Err 200 2.2]
+set y1 [Err 50 1.2]
+set y2 [Err 100 2.3]
+# Evaluate in a local context to clean up intermediate objects
+set d [scope {
+    [[[$x1 - $x2] ** 2] + [[$y1 - $y2] ** 2]] ** 0.5
+}]
+puts "d = [$d p]"