TEMP

src/core/localize.rkt

@@ -130,19 +130,27 @@
 
 ; Compute local error or each sampled point at each node in `prog`.
 (define (compute-local-errors subexprss ctx)
+  (define var-count (length (context-vars ctx)))
   (define exprs-list (append* subexprss)) ; unroll subexprss
+  (eprintf "var count: ~a\n" var-count)
   (define ctx-list
     (for/list ([subexpr (in-list exprs-list)])
       (struct-copy context ctx [repr (repr-of subexpr ctx)])))
 
   (define expr-batch (progs->batch exprs-list))
   (define nodes (batch-nodes expr-batch))
   (define roots (batch-roots expr-batch))
+  (define spec-list (map prog->spec exprs-list))
+  (define spec-vec (list->vector spec-list))
+  (eprintf "~a exprs-list: ~a\n" (length exprs-list) exprs-list)
+  (eprintf "~a specs: ~a\n" (vector-length spec-vec) spec-vec)
+  (eprintf "~a nodes: ~a\n" (vector-length nodes) nodes)
+  (eprintf "~a roots: ~a\n" (vector-length roots) roots)
 
   ; TODO don't ignore the status code from make-real-compiler in eval-progs-real
-  (define subexprs-fn (eval-progs-real (map prog->spec exprs-list) ctx-list))
+  (define subexprs-fn (eval-progs-real spec-list ctx-list))
   (define actual-value-fn (compile-progs exprs-list ctx))
-  (define diffMachine (rival-compile (list `(- e a)) '(e a) (list flonum-discretization)))
+  ; (define diffMachine (rival-compile (list `(- e a)) '(e a) (list flonum-discretization)))
 
   (define errs
     (for/vector #:length (vector-length roots)
@@ -159,37 +167,99 @@
                 ([node (in-vector roots)])
       (make-vector (pcontext-length (*pcontext*)))))
 
-  (for ([(pt ex) (in-pcontext (*pcontext*))]
-        [pt-idx (in-naturals)])
-
-    (define exacts (list->vector (apply subexprs-fn pt)))
-    (define actuals (apply actual-value-fn pt))
-
-    (for ([expr (in-list exprs-list)]
-          [root (in-vector roots)]
-          [exact (in-vector exacts)]
-          [actual (in-vector actuals)]
-          [expr-idx (in-naturals)])
-      (define diff
-        (vector-ref (rival-apply diffMachine (list->vector `(,(bf exact) ,(bf actual)))) 0))
-      (define err
-        (match (vector-ref nodes root)
-          [(? literal?) 1]
-          [(? variable?) 1]
-          [(approx _ impl)
-           (define repr (repr-of expr ctx))
-           (ulp-difference exact (vector-ref exacts (vector-member impl roots)) repr)]
-          [`(if ,c ,ift ,iff) 1]
-          [(list f args ...)
-           (define repr (impl-info f 'otype))
-           (define argapprox
-             (for/list ([idx (in-list args)])
-               (vector-ref exacts (vector-member idx roots)))) ; arg's index mapping to exact
-           (define approx (apply (impl-info f 'fl) argapprox))
-           (ulp-difference exact approx repr)]))
-      (vector-set! (vector-ref exacts-out expr-idx) pt-idx exact)
-      (vector-set! (vector-ref errs expr-idx) pt-idx err)
-      (vector-set! (vector-ref diffs-out expr-idx) pt-idx diff)))
+  ; (for ([(pt ex) (in-pcontext (*pcontext*))]
+  ;       [pt-idx (in-naturals)])
+  (define pt-idx (list 0 1))
+  (define pt (list 3.3 4.3))
+
+  (define exacts (list->vector (apply subexprs-fn pt)))
+  (eprintf "exacts: ~a\n" exacts)
+  (define actuals (apply actual-value-fn pt))
+
+  ;; Don't love that we do this per point iteration but oh well.
+  (define actuals-map
+    (for/hash ([subexpr (in-list exprs-list)]
+               [actual (in-vector actuals)])
+      (values subexpr actual)))
+  (define exacts-map
+    (for/hash ([subexpr (in-list exprs-list)]
+               [exact (in-vector exacts)])
+      (values subexpr exact)))
+
+  ;; Roots maps specs to node index, as node and spec/exacts are in different orderings.
+  (for ([expr (in-list exprs-list)]
+        [root (in-vector roots)]
+        [exact (in-vector exacts)]
+        [actual (in-vector actuals)]
+        [expr-idx (in-naturals)])
+    (define true-error
+      (match (vector-ref nodes root)
+        [(? literal?)
+         (eprintf "LITERAL[exact: ~a, root: ~a]\n" exact root)
+         0]
+        [(? variable?)
+         (eprintf "VARIABLE[exact: ~a, root: ~a]\n" exact root)
+         0]
+        [(approx _ impl)
+         (define repr (repr-of expr ctx))
+         (eprintf "APPROX[exact: ~a, root: ~a]\n" exact root)
+         1] ;; TODO
+        ;; ??? Do I ignore this as well?
+        [`(if ,c ,ift ,iff) 0]
+        [(list f args ...)
+         ;; Find the index of the variables we need to substitute.
+         (eprintf "node: ~a, spec: ~a\n" (vector-ref nodes root) (vector-ref spec-vec root))
+         (define var-indexs (list))
+         (define var-names (list))
+         (define var-values (list))
+         (for/list ([idx (in-list args)])
+           (match (vector-ref nodes idx)
+             [(? variable?)
+              (set! var-indexs (cons idx var-indexs))
+              (define var-name (vector-ref spec-vec (vector-member idx roots)))
+              (define var-value (hash-ref exacts-map var-name))
+              (set! var-values (cons var-value var-values))
+              (set! var-names (cons var-name var-names))]
+             [_ empty]))
+         (eprintf "var index: ~a\n" var-indexs)
+         (eprintf "var-names: ~a\n" var-names)
+         (eprintf "var-values: ~a\n" var-values)
+
+         (eprintf "EXPR[exact: ~a, root: ~a]\n" exact root)
+         (define repr (impl-info f 'otype))
+         (eprintf "args: ~a\n" args)
+         (eprintf "f: ~a\n" f)
+         (define temp-exacts
+           (for/list ([idx (in-list args)])
+             (vector-ref exacts (vector-member idx roots))))
+         (eprintf "temp-exacts: ~a\n" temp-exacts)
+         (define temp-specs
+           (for/list ([idx (in-list args)])
+             (vector-ref spec-vec (vector-member idx roots))))
+         (eprintf "temp-specs: ~a\n" temp-specs)
+         ; arg's index mapping to exact
+         1])) ;; TODO
+    ; (define evaluator (rival-compile spec vars (list flonum-discretization)))
+    ; (define diff (vector-ref (rival-apply diffMachine (list->vector `(,(bf exact) ,(bf actual)))) 0))
+    (define err
+      (match (vector-ref nodes root)
+        [(? literal?) 1]
+        [(? variable?) 1]
+        [(approx _ impl)
+         (define repr (repr-of expr ctx))
+         (ulp-difference exact (vector-ref exacts (vector-member impl roots)) repr)]
+        [`(if ,c ,ift ,iff) 1]
+        [(list f args ...)
+         (define repr (impl-info f 'otype))
+         (define argapprox
+           (for/list ([idx (in-list args)])
+             (vector-ref exacts (vector-member idx roots)))) ; arg's index mapping to exact
+         (define approx (apply (impl-info f 'fl) argapprox))
+         (ulp-difference exact approx repr)]))
+    (vector-set! (vector-ref exacts-out expr-idx) pt-idx exact)
+    (vector-set! (vector-ref errs expr-idx) pt-idx err)
+    (vector-set! (vector-ref diffs-out expr-idx) pt-idx #f))
+  ; )
 
   (define n 0)
   (for/list ([subexprs (in-list subexprss)])