; retrodiction (define (tfn so sn) (let* ((n2 (vector-length (cdr so)))(s (make-vector n2 '()))) (if (not (= n2 (vector-length sn))) ((mer "different lengths") "Pooh") (Do n2 (lambda (j) (let* ((lc (vector-ref (cdr so) j))(nv (vector-ref sn j))) (vector-set! s j (cons (- (let sum ((h (cdr lc))) (let ((id (caar h))) (if (= id n2) (- (vector-ref sn j)) (+ (sum (cdr h)) (* (cdar h) (vector-ref sn id))))))) (cdr lc))))))) (cons (car so) s))) (define f '#(1 3 4 0 6 4 3 4 2 4 2 9)) (define s (tfn (vg 3 4) f)) (solve s ge) s (define (verify sp sf er) (let* ((n2 (vector-length (cdr sp))) (sum (lambda (t) (let sum ((h t)) (let ((id (caar h))) (if (= id n2) 0 (+ (sum (cdr h)) (* (cdar h) (vector-ref sf id))))))))) (if (not (= n2 (vector-length sf))) ((mer "different lengths") "Pooh")) (Do n2 (lambda (j) (let* ((lc (vector-ref (cdr sp) j))(nv (vector-ref sf j)) (cv (call-with-current-continuation (lambda (r) (if (not (or (and (number? (car lc)) (r (+ (car lc) (sum (cdr lc))))) (and (string=? (car lc) "d") (r (+ (cadr lc) (sum (cddr lc))))) (and (string=? (car lc) "k") (r (cdr lc))))) ((mer "Wrong format") (list j lc))))))) (if (not (= nv cv)) (er (list j nv cv lc)))))))) (define (Solve s f) (let ((n (vector-length (cdr s)))) (ln s (mer "Initial input")) (verify s f (mer "Initially:")) (Do n (lambda (j) (retire s j) (verify s f (mer (list j "after retire"))))) (Do n (lambda (j) (let ((zil (bs s (- (- n 1) j)))) (verify s f (mer (list j zil "after bs" s f)))))))) (define s (tfn (vg 3) f)) (Solve s f)