;;
;; Put this file in the Extras directory in the directory in
;; which you start Arc.
;; Source:  http://www.stat.umn.edu/arc
;;

(unless (member 'ares-menu-item *arc-linear-regression-menu-items*)
  (defparameter *arc-linear-regression-menu-items*
    (append *arc-linear-regression-menu-items* 
            (list 'ares-menu-item))))

#|
;;; The following code is given here for completeness, but it is contained in 
;;; the standard arc, so it is not needed.

;;;
;;; ares plots
;;;
(defmeth regression-model-proto :ares (&rest args)
"Produces and ARES plot (Cook and Weisberg, 1989) Technometrics, p 279.
All options are selected via dialog boxes."
    (let* ((basis (send self :basis))
           (names (select (send self :predictor-names) basis))
           (sel (let ((s (ares-dialog names)))
                  (if (null s) (return-from :ares))
                  s))
           (add (second sel))
           (group (if (= (length add) 1) t
                      (select (list nil t) (select sel 2)))))
          (send self :ares1 add group)))

(defun ares-dialog (items)
  (let* ((all (send allocate-items-proto :new))
			(left (send subordinate-list-proto :new items 'primary all))
			(right (send subordinate-list-proto :new (repeat "" (length items))
							 'secondary all))
			(left-title (send text-item-proto :new "Candidates"))
			(right-title (send text-item-proto :new "Selection"))
         (title (send text-item-proto :new "ARES plot..."))
         (cancel (send modal-button-proto :new "Cancel"))
         (type (send choice-item-proto :new 
                     (list "Sequential" "As a group")))
         (ok (send modal-button-proto :new "OK" :action 
                   #'(lambda () 
                      (cond ((null (second (send all :value)))
									  (message-dialog "Choose at least 1 predictor")
									  (ares-dialog items))
									 (t (list (select (send all :value) 0)
                                      (select (send all :value) 1)
                                      (send type :value)))))))
         (dialog (send modal-dialog-proto :new
                       (list 
                        (list title type)
                        (list 
                         (list left-title left)
                         (list right-title right))
                        (list ok cancel)))))
    (send dialog :default-button ok)
    (send dialog :modal-dialog)))

(defmeth regression-model-proto :ares1 (add group &key (plot-controls t))
  (let* ((y (send self :y))
         (add-all (= (length (send self :basis)) (length add)))
         (missing (find-missing (send self :residuals)))
         r yhat 
         (data #'(lambda ()
            (setf r (send self :make-clone))
            (setf yhat (reverse (cond 
              ((and group add-all) (list (send r :fit-values)
                   (repeat (mean (if-else (send r :included) (send r :y) 0))
                            (send r :num-cases))))
              (group (let ((f1 (send r :fit-values)))
                    (mapcar #'(lambda (v) (send r :delete-predictor v)) add)
                 (list f1 (send r :fit-values))))
              (add-all (append (list (send r :fit-values)) 
                        (mapcar #'(lambda (v) (send r :delete-predictor v) 
                         (send r :fit-values)) (reverse (rest add)))
                         (list (repeat (mean (if-else (send r :included) 
                           (send r :y) 0)) (send r :num-cases)))))
              (t (cons (send r :fit-values)
                       (mapcar #'(lambda (v) (send r :delete-predictor v)
                              (send r :fit-values)) (cons nil add)))))))
             (list (select yhat 0) (- y (select yhat 0)))))
         (ares-plot (send self :make-plot data
                '("Fit-values" "Residuals")
                :title (format nil "(~a) ARES plot for ~a" (send self :name)add)
                :plot-controls plot-controls))
         (action #'(lambda (slider) 
             (let* ((num (floor slider))
                    (lam (- slider num)) 
                    (yh (select yhat (min (if group 1 (length add)) (1+ num))))
                    (yh1 (select yhat num))
                    (yhatlam (- yh (* (- 1 lam) (- yh yh1))))
                    (ehatlam (- y yhatlam)))
                 (send ares-plot :draw-next-frame '(0 1) 
                 (list yhatlam ehatlam)))))
          (seq (* .01 (round (* 100 (rseq 0 (if group 1 (length add))
                (if group 21 (+ 1 (* 10 (length add)))))))))
          (slider (send ares-plot :ares-plot-control seq seq plot-controls)))
   (apply #'send ares-plot :nice-range 0 (range yhat))
   (apply #'send ares-plot :nice-range 1
        (range (mapcar #'(lambda (a) (- y a)) yhat)))
   (defmeth slider :do-action (lam) (funcall action lam))
   (if missing 
     (send ares-plot :point-masked missing (repeat t (length missing))))
   ares-plot))

(defmeth graph-proto :ares-plot-control (seq disp plot-controls)
  (when (null plot-controls) 
           (let* ((top (+ 8 (* 2 (+ (send self :text-ascent)
                                    (send self :text-descent))))))
            (apply #'send self :margin (+ (send self :margin)
                                         (list 0 top 0 0)))
            (send self :add-slot 'overlay-loc '(10 2))
            (apply #'send self :size (+ (send self :size) (list 0 top)))
            (send self :resize)))
  (send slider-control-proto :new seq
                    :display disp
                    :location (send self :locate-next-control :height 2)
                    :graph self
                    :length (send self :slider-width)
                    :title "lambda"))

;;;
;;; Ares plots for glims
;;;

(defmeth normalreg-proto :ares (&rest args)
  (cond ((eq (send self :link) identity-link) 
         (apply #'call-method regression-model-proto :ares args))
        (t (apply #'send self :call-next-method args))))

(defmeth normalreg-proto :ares1 (&rest args)
  (cond ((eq (send self :link) identity-link) 
         (apply #'call-method regression-model-proto :ares1 args))
        (t (apply #'send self :call-next-method args))))

(defmeth glim-proto :ares (&rest args)
"Produces and ARES plot (Cook and Weisberg, 1994, \"ARES plots for generalized
linear models,\" Computational Statistics and Data Analysis, 17, 303-316."
    (let* ((names (send self :predictors))
           (sel (let ((s (select-list-dialog names
                          :title "ARES plot of..."
                          :left-title "Candidates"
                          :right-title "Selections...")))
                  (if (null s) (return-from :ares))
                  (if (null (second s)) (return-from :ares))
                  s))
           (base (select names (first sel)))
           (add (select names (second sel))))
          (apply  #'send self :ares1 base add args)))

(defmeth glim-proto :ares1 (base add &rest args &key 
                  (lambda (combine 0 .05 (rseq .1 .9 9) .95 1))
                  (plot-controls t) (x-axis :eta) (y-axis :g2-residuals) )
    (let* (x1 x2 y1 y2 m
           (missing (find-missing (send self :residuals)))
           (d (send self :data)) 
           (b (cond ((and (null base) (send self :intercept)) '("Ones"))
                    (t base)))
           (data #'(lambda () 
             (setf m (send self :make-clone))
             (if (null base) (send m :intercept nil))
             (send m :x (apply #'append (mapcar 
                 #'(lambda (n) (send d :data n)) b)))  
             (setf y1 (send m y-axis))
             (setf x1 (send m x-axis))
             (setf y2 (send self y-axis))
             (setf x2 (send self x-axis))
             (list x1 y1)))
           (title (format nil "ARES:~a + ~a" base add))
           (xrange #'(lambda (x) (list (min x) (max x))))
           (labels (mapcar #'(lambda (a) (methname-to-string a))
                           (list x-axis y-axis)))
           (ares-plot (apply #'send self :make-plot data labels
                    :title title :plot-controls plot-controls args))
           (slider (send ares-plot :ares-plot-control 
                         (iseq (length lambda)) lambda plot-controls)))
      (apply #'send ares-plot :nice-range 0 (funcall xrange (combine x1 x2)))
      (apply #'send ares-plot :nice-range 1 (funcall xrange (combine y1 y2)))
      (when missing (send ares-plot :point-masked missing 
                    (repeat t (length missing))))
      (send ares-plot :redraw)
      (defmeth slider :do-action (lam) 
        (let* ((l (select lambda lam))
               (x (+ (* (- 1 l) x1) (* l x2)))
               (y (+ (* (- 1 l) y1) (* l y2))))
        (send ares-plot :draw-next-frame '(0 1) (list x y))))
      ares-plot))

  (let ((p (position 'ospm-menu-item  *arc-glm-regression-menu-items2*)))
    (defparameter  *arc-glm-regression-menu-items2*
      (append (select *arc-glm-regression-menu-items2* (iseq p))
              (list 'ares-menu-item)
              (select *arc-glm-regression-menu-items2* 
                (iseq p (1- (length *arc-glm-regression-menu-items2*)))))))
  (let ((p (position 'ospm-menu-item  *arc-linear-regression-menu-items*)))
    (defparameter  *arc-linear-regression-menu-items*
      (append (select *arc-linear-regression-menu-items* (iseq p))
              (list 'ares-menu-item)
              (select *arc-linear-regression-menu-items* 
                (iseq p (1- (length *arc-linear-regression-menu-items*)))))))
 )
|#