anchor.diff:        (dotimes (x 28)
           (princ (if (< 0.5 (aref a (+ (* y 28) x))) #\O #\.)))
         (terpri))))
  -
  -#+nil
  -(dotimes (i 100)
  -  (print-image-array (image-array (aref (training-images) i)))
  -  (print (image-label (aref (training-images) i)))
  -  (terpri))
   
   (defun read-image-arrays (stream)
     (read-magic-or-lose stream 2051)
  
positive.code:                               :target expectations))
      (ce-error (->error :x predictions))))
  
  (defvar *bpn/4*)
  
  (defparameter *mnist-4-bpn-filename*
    (merge-pathnames "mnist-4.bpn" *mnist-save-dir*))
  
  (defun train-mnist/4 (&key quick-run-p)
    (setq *bpn/4* (build-maxout-mnist-bpn))
    (init-bpn-weights *bpn/4* :stddev 0.01)
    (train-mnist-bpn-gd *bpn/4* (training-images) (test-images)
                        :n-softmax-epochs 0
                        :n-epochs (if quick-run-p 2 3000)
                        :learning-rate (flt 1)
                        :learning-rate-decay (flt 0.998)
                        :l2-upper-bound (sqrt (flt 3.75)))
    (unless quick-run-p
      (save-weights *mnist-4-bpn-filename* *bpn/4*)))
  
  #|
  
  (progn
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/1)))
  
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/1 :load-dbn-p t :dropoutp t)))
  
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/2)))
  
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/2 :load-dbm-p t :dropoutp t)))
  
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/3)))
  
    (with-cuda ()
      (let ((*random-state* (sb-ext:seed-random-state 983274)))
        (train-mnist/4))))
  
  (with-cuda ()
    (let ((*random-state* (sb-ext:seed-random-state 983274)))
      (train-mnist/2 :load-dbn-p t :dropoutp t)))
  
  (require :sb-sprof)
  
  
negative.code:       (init-weights 'prediction-biases bpn 0.1)
        bpn)))
  
  (defun train-mnist/1 (&key (training *training*) (test *test*) load-dbn-p
                        quick-run-p dropoutp dbn-var bpn-var
                        dbn-filename bpn-filename)
    (let ((dbn nil)
          (bpn nil))
      (cond (load-dbn-p
             (setq* (dbn dbn-var) (make-instance 'mnist-dbn/1))
             (load-weights dbn-filename dbn)
             (log-msg "Loaded DBN~%")
             (map nil (lambda (counter)
                        (log-msg "dbn test ~:_~A~%" counter))
                  (collect-dbn-mean-field-errors/labeled
                   (make-sampler test) dbn)))
            (t
             (setq* (dbn dbn-var) (make-instance 'mnist-dbn/1))
             (init-mnist-dbn dbn :stddev 0.1)
             (train-mnist-dbn dbn training test
                              :n-epochs (if quick-run-p 2 50) :n-gibbs 1
                              :start-level 0 :learning-rate (flt 0.1)
                              :decay (flt 0.0002) :visible-sampling nil)
             (unless quick-run-p
               (save-weights dbn-filename dbn))))
      (setq* (bpn bpn-var) (unroll-mnist-dbn/1 dbn))
      (cond (dropoutp
             (train-mnist-bpn-gd bpn training test
                                 :n-softmax-epochs (if quick-run-p 1 10)
                                 :n-epochs (if quick-run-p 2 1000)
                                 :learning-rate (flt 1)
                                 :learning-rate-decay (flt 0.998)
                                 :l2-upper-bound nil
                                 :rescale-on-dropout-p t)
             (unless quick-run-p
               (save-weights bpn-filename bpn)))
            (t
             (train-mnist-bpn bpn training test
                              :n-softmax-epochs (if quick-run-p 1 5)
                              :n-epochs (if quick-run-p 1 37))
             (unless quick-run-p
               (save-weights bpn-filename bpn))))))
  
  
  ;;;; Code for the DBN to DBM to BPN approach (paper [2]) and also for
  ;;;; dropout training with the bpn (paper [3]) with :DROPOUT T.
  
  (defclass mnist-rbm/2 (mnist-rbm) ())
  (defclass mnist-bpn/2 (mnist-bpn bpn-clamping-cache) ())
  