(load "inverse")

; this stuff is done once and for all
(format t "reading in jacobian matrix ~%")
(setf vsp-model (send inverse-proto :new))
(send vsp-model :read-jacobian "jacobian")
(send vsp-model :read-rhs "tt")
(send vsp-model :title "VSP travel time inversion")
(send vsp-model :zmin 1)
(send vsp-model :zmax 23)


(format t "computing svd matrix ~%")
(format t "gui will appear after this is done ~%")
(send vsp-model :compute-svd)

(setf truncate 0) ;default truncation level
(send vsp-model :eps truncate)
(setf noise .1)   ; default noise level = 1 ms
(send vsp-model :sig noise)

; this stuff is done interactively
(defun describe ()
  (send vsp-model :describe)
  )

(defun runit ()
  (send vsp-model :eps truncate)
  (send vsp-model :sig noise)
  (send vsp-model :truncated-svd-solution)
  (send vsp-model :lower-bound (make-array (send vsp-model :num-cols)
					       :initial-element (/ 1 3)))
  (send vsp-model :upper-bound (make-array (send vsp-model :num-cols)
					       :initial-element (/ 1 .2)) )
  (send vsp-model :constrained-solution (constrain (send vsp-model :upper-bound)
						 (send vsp-model :lower-bound)
						 (send vsp-model :solution)))
  (send vsp-model :response (matmult (send vsp-model :jacobian) 
                            (send vsp-model :constrained-solution)))
;  (send vsp-model :plot-solution)
;  (send vsp-model :plot-response)
  (format t "normalized chi-squared ~f ~%" (send vsp-model :chisq))
  )


; plot functions
(defun plotsolution () (send vsp-model :plot-solution))
(defun plotresponse () (send vsp-model :plot-response))
(defun plothistogram () (send vsp-model :residual-histogram))

; set up a gui.  scr

; first make the buttons
(setf ok (send button-item-proto :new "Compute SVD solution" 
	       :action #'runit))
(setf quit (send button-item-proto :new "Quit Xlisp-Stat" :action 'exit))
(setf describe (send button-item-proto :new "Describe" :action 'describe))
(setf plotsolution (send button-item-proto :new "Plot Model" 
		      :action 'plotsolution))
(setf plotresponse (send button-item-proto :new "Plot Data" 
		     :action 'plotresponse))
(setf plothistogram (send button-item-proto :new "Residual Histogram"
		     :action 'plothistogram))

; make the sliders
(setf trunc-label (send text-item-proto :new 
			"Fraction of dropped singular values"))
(setf trunc-value (send text-item-proto :new " " :text-length 3 ))
(setf trunc-scroll (send sequence-scroll-item-proto :new 
                   (rseq 0 .3 50) :text-item trunc-value :action
                   #'(lambda (x) (setf truncate x))
                   ))
(send trunc-scroll :value 0)


(setf noise-label (send text-item-proto :new 
			"Noise level in milliseconds"))
(setf noise-value (send text-item-proto :new "  " :text-length 3 ))
(setf noise-scroll (send sequence-scroll-item-proto :new 
                   (rseq .1 2 50) :text-item noise-value :action
                   #'(lambda (x) (setf noise x))
                   ))
(send noise-scroll :value 0)




; create the window and install the widgets
(send dialog-proto :title "Truncated SVD solution")
(send dialog-proto :location 300 500)
(send dialog-proto :new (list 
			 (list trunc-label trunc-value trunc-scroll)
			 (list noise-label noise-value noise-scroll)
			 (list ok describe)
			 (list plotsolution plotresponse plothistogram)
			 (list quit)
			 )
      )