September 2017 Update

Task/Numeric-error-propagation/Common-Lisp/numeric-error-propagation.lisp

@@ -0,0 +1,58 @@
+(defstruct uncertain-number
+  (value 0 :type number)
+  (uncertainty 0 :type number))
+
+(defmethod print-object ((n uncertain-number) stream)
+  (format stream "~,2F ± ~,2F" (uncertain-number-value n) (uncertain-number-uncertainty n)))
+
+(defun ~+ (n1 n2)
+  (let* ((value1 (uncertain-number-value n1))
+         (value2 (uncertain-number-value n2))
+         (uncertainty1 (uncertain-number-uncertainty n1))
+         (uncertainty2 (uncertain-number-uncertainty n2))
+         (value (+ value1 value2))
+         (uncertainty (sqrt (+ (* uncertainty1 uncertainty1)
+                               (* uncertainty2 uncertainty2)))))
+    (make-uncertain-number :value value :uncertainty uncertainty)))
+
+(defun negate (n)
+  (make-uncertain-number :value (- (uncertain-number-value n))
+                         :uncertainty (uncertain-number-uncertainty n)))
+
+(defun ~- (n1 n2)
+  (~+ n1 (negate n2)))
+
+(defun ~* (n1 n2)
+  (let* ((value1 (uncertain-number-value n1))
+         (value2 (uncertain-number-value n2))
+         (uncertainty-ratio-1 (/ (uncertain-number-uncertainty n1) value1))
+         (uncertainty-ratio-2 (/ (uncertain-number-uncertainty n2) value2))
+         (value (* value1 value2))
+         (uncertainty (sqrt (* value
+                               value
+                               (+ (* uncertainty-ratio-1 uncertainty-ratio-1)
+                                  (* uncertainty-ratio-2 uncertainty-ratio-2))))))
+    (make-uncertain-number :value value :uncertainty uncertainty)))
+
+(defun inverse (n)
+  (make-uncertain-number :value (/ (uncertain-number-value n))
+                         :uncertainty (uncertain-number-uncertainty n)))
+
+(defun ~/ (n1 n2)
+  (~* n1 (inverse n2)))
+
+(defun ~expt (base exp)
+  (let* ((base-value (uncertain-number-value base))
+         (uncertainty-ratio (/ (uncertain-number-uncertainty base) base-value))
+         (value (expt base-value exp))
+         (uncertainty (abs (* value exp uncertainty-ratio))))
+    (make-uncertain-number :value value :uncertainty uncertainty)))
+
+(defun solve ()
+  (let* ((x1 (make-uncertain-number :value 100 :uncertainty 1.1))
+         (y1 (make-uncertain-number :value  50 :uncertainty 1.2))
+         (x2 (make-uncertain-number :value 200 :uncertainty 2.2))
+         (y2 (make-uncertain-number :value 100 :uncertainty 2.3))
+         (d  (~expt (~+ (~expt (~- x1 x2) 2) (~expt (~- y1 y2) 2))
+                    1/2)))
+    (format t "d = ~A~%" d)))

Task/Numeric-error-propagation/Fortran/numeric-error-propagation-2.f

@@ -20,8 +20,13 @@
           IF (VSP.LE.0) THEN	!Just in case
             WRITE (VOUT,1) "Empty",VSP	!My stack may be empty.
            ELSE			!But normally, it is not.
-            WRITE (VOUT,1) WOT,VSP,STACKV(VSP),PM,STACKE(VSP)	!Topmost.
-    1       FORMAT (A8,": Vstack(",I2,") =",F8.1,A1,F6.2)	!Suits the example.
+            IF (STACKV(VSP).EQ.0) THEN	!But it might have a zero value!
+              WRITE (VOUT,1) WOT,VSP,STACKV(VSP),PM,STACKE(VSP)		!Alas. No percentage, then.
+    1         FORMAT (A8,": Vstack(",I2,") =",F8.1,A1,F6.2,F9.1,"%")	!Suits the example.
+             ELSE		!Avoiding a divide-by-zero is polite.
+              WRITE (VOUT,1) WOT,VSP,STACKV(VSP),PM,STACKE(VSP),	!Possibly, a surprise, still.
+     1         STACKE(VSP)/STACKV(VSP)*100	!The relative error may well be interesting.
+            END IF		!The pearls have been cast.
           END IF		!So much for protection.
         END SUBROUTINE VSHOW	!Could reveal all the stack...
 

Task/Numeric-error-propagation/Julia/numeric-error-propagation.julia

@@ -0,0 +1,59 @@
+module NumericError
+
+import Base: convert, promote_rule, +, -, *, /, ^
+
+export Measure
+
+type Measure <: Number
+  x::Float64
+  σ::Float64
+  Measure(x::Real) = new(Float64(x), 0)
+  Measure(x::Real, σ::Real) = new(Float64(x), σ)
+end
+
+Base.show(io::IO, x::Measure) = print(io, string(x.x, " ± ", x.σ))
+
+Base.convert(::Type{Measure}, x::Real) = Measure(Float64(x), 0.0)
+Base.promote_rule(::Type{Float64}, ::Type{Measure}) = Measure
+Base.promote_rule(::Type{Int64}, ::Type{Measure}) = Measure
+
++(a::Measure, b::Measure) = Measure(a.x + b.x, sqrt(a.σ ^ 2 + b.σ ^ 2))
+-(a::Measure, b::Measure) = Measure(a.x - b.x, sqrt(a.σ ^ 2 + b.σ ^ 2))
+-(a::Measure) = Measure(-a.x, a.σ)
+
+*(a::Measure, b::Measure) = begin
+  x = a.x * b.x
+  σ = sqrt(x ^ 2 * ((a.σ / a.x) ^ 2 + (b.σ / b.x) ^ 2))
+  Measure(x, σ)
+end
+/(a::Measure, b::Measure) = begin
+  x = a.x / b.x
+  σ = sqrt(x ^ 2 * ((a.σ / a.x) ^ 2 + (b.σ / b.x) ^ 2))
+  Measure(x, σ)
+end
+
+^(a::Measure, b::Float64) = begin
+  x = a.x ^ b
+  σ = abs(x * b * a.σ / a.x)
+  Measure(x, σ)
+end
+
+Base.sqrt(a::Measure) = a ^ .5
+
+end  # module NumericError
+
+using NumericError
+
+# x1 = 100 ± 1.1
+# y1 = 50 ± 1.2
+# x2 = 200 ± 2.2
+# y2 = 100 ± 2.3
+
+x1 = Measure(100, 1.1)
+y1 = Measure(50,  1.2)
+x2 = Measure(200, 2.2)
+y2 = Measure(100, 2.3)
+
+d = sqrt((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+
+@show x1 y1 x2 y2 sqrt((x1 - x2) ^ 2 + (y1 - y2) ^ 2)