(Arne Babenhauserheide)
2014-11-26: fit a polynomial. fit a polynomial.
diff --git a/examples/ensemble-estimation.w b/examples/ensemble-estimation.w --- a/examples/ensemble-estimation.w +++ b/examples/ensemble-estimation.w @@ -53,25 +53,46 @@ define : standard-deviation-from-deviati / : sum-ec (: i l) : expt i 2 . {(length l) - 1} -define : H x - . "Observation operator. It generates modelled observations from the input " - apply + : list-ec (: i (length x)) : * {i + 1} : list-ref x i +define* : write-multiple . x + . "Helper to avoid suffering from write-newline-typing." + map : lambda (x) (write x) (newline) + . x + +define : H x pos + . "Observation operator. It generates modelled observations from the input. + +x are parameters to be optimized, pos is another input which is not optimized. For plain functions it could be the position of the measurement on the x-axis. We currently assume absolute knowledge about the position. +" + apply + : list-ec (: i (length x)) : * {i + 1} : expt {pos * (list-ref x i)} i ;; Start with the simple case: One variable and independent observations (R diagonal) +;; First define a truth +define x^true '(0.5 0.6 0.7 0.1) + +;; Then generate observations +define y⁰-num 1000 +;; At the positions where they are measured, just a 10% variation +define y⁰-pos : list-ec (: i y⁰-num) i + +;; We start with true observations which we will disturb later to get +;; the equivalent of measured observations +define y^true : list-ec (: i y⁰-pos) : H x^true i +;; now we disturb the observations with a fixed standard deviation. This assumes uncorrelated observations. +define y⁰-std 0.1 +define y⁰ : list-ec (: i y^true) : + i : * y⁰-std : random:normal +;; and define the covariance matrix. This assumes uncorrelated observations. +define R : make-covariance-matrix-from-standard-deviations : list-ec (: i y⁰-num) y⁰-std + +;; Alternative: define observations +;; define y⁰-mean 0.8 +;; The actual observations +;; define y⁰ : list-ec (: i y⁰-num) : + y⁰-mean : * y⁰-std : random:normal + +;; And add an initial guess of the parameters define x^b '(1 1 1 1) ; initial guess define P : make-covariance-matrix-from-standard-deviations '(0.5 0.1 0.3 0.1) -define y⁰-num 1000 -define y⁰-mean 0.8 -define y⁰-std 0.01 -define y⁰ : list-ec (: i y⁰-num) : + y⁰-mean : * y⁰-std : random:normal -define R : make-covariance-matrix-from-standard-deviations : list-ec (: i y⁰-num) y⁰-std - -define* : write-multiple . x - map : lambda (x) (write x) (newline) - . x - -define : EnSRT H x P y R N +define : EnSRT H x P y R y-pos N . "Observation function H, parameters x, parameter-covariance P, observations y, observation covariance R and number of ensemble members N. @@ -81,6 +102,7 @@ Limitations: y is a single value. R and let process-observation : observations-to-process y observation-variances : list-ec (: i (length y)) : list-ref (list-ref R i) i + observation-positions y-pos x^b x x-deviations list-ec (: i N) @@ -96,11 +118,13 @@ Limitations: y is a single value. R and let* : y_cur : car observations-to-process R_cur : car observation-variances + y-pos_cur : car observation-positions Hx^b_i list-ec (: i x-deviations) H list-ec (: j (length i)) + (list-ref x^b j) (list-ref i j) + . y-pos_cur Hx^b / : sum-ec (: i Hx^b_i) i . N @@ -135,22 +159,27 @@ Limitations: y is a single value. R and process-observation cdr observations-to-process cdr observation-variances + cdr observation-positions . x^a . x^a-deviations let* - : optimized : EnSRT H x^b P y⁰ R 300 + : optimized : EnSRT H x^b P y⁰ R y⁰-pos 300 x-opt : list-ref optimized 0 x-deviations : list-ref optimized 1 ; std : sqrt : * {1 / {(length x-deviations) - 1}} : sum-ec (: i x-deviations) : expt i 2 - format #t "x⁰: ~A ± ~A\nx: ~A ± ~A\ny: ~A ± ~A\ny⁰: ~A ± ~A" + format #t "x⁰: ~A ± ~A\nx: ~A ± ~A\nx^true: ~A\ny: ~A ± \ny⁰: ~A ± ~A" . x^b list-ec (: i (length x^b)) : list-ref (list-ref P i) i . x-opt - list-ec (: i (length x-opt)) - apply standard-deviation-from-deviations : list-ec (: j x-deviations) : list-ref j i - H x-opt - apply standard-deviation-from-deviations : map H x-deviations ; FIXME: This only works for completely linear H. + ; list-ec (: i (length x-opt)) + ; apply standard-deviation-from-deviations : list-ec (: j x-deviations) : list-ref j i + . #t + . x^true + * {1 / (length y⁰)} : apply + : map (lambda (x) (H x-opt x)) y⁰-pos + ; apply standard-deviation-from-deviations : map H x-deviations ; FIXME: This only works for trivial H. * {1 / (length y⁰)} : apply + y⁰ * : sqrt {1 / (length y⁰)} . y⁰-std + +