#|
Correlation demonstration.
Demonstrates Leverage and Restriction of Range.
Written by Viji Sathy and Forrest Young, December, 1997
|#

(setf gpa '(3.4 3.65 2.9 2.5 3.07 2.3 2.75 3.3 3.4 3.0 3.7 3.1 
3.0 2.9 2.9 3.2 2.8 3.5 3.0 2.9 2.85 2.2 2.8 3.6 2.8 2.5 2.9 
3.86 2.8 2.6 3.5 3.5 2.5 3.2 3.74 3.7 2.5 3.93 2.8 2.8 3.2))                                                                                                           
    
(setf mathsat '(640.0 550.0 640.0 620.0 440.0 710.0 600.0 680.0 
560.0 550.0 680.0 575.0 720.0 490.0 590.0 650.0 340.0 550.0 610.0 
560.0 440.0 400.0 600.0 610.0 690.0 530.0 650.0 590.0 670.0 490.0 
700.0 720.0 500.0 480.0 750.0 600.0 700.0 680.0 520.0 540.0 550.0))                                                                                              

;CONSTRUCTOR FUNCTION AND DEFPROTO (FOR REGRESS-PLOT-PROTO):                                              

(defun reg-plot  (data &key (title "Correlation Demo") (show t) 
                       location size (go-away t) variable-labels) 
  (send regress-plot-proto :new data :show show :title title :location
        location :size size :go-away go-away :variable-labels
variable-labels))    

(defproto regress-plot-proto '(data origcoefs coefs overlay) nil
  scatterplot-proto)              

(defmeth regress-plot-proto :data (&optional (list nil set))
  (if set (setf (slot-value 'data) list))
  (slot-value 'data))

(defmeth regress-plot-proto :overlay (&optional (list nil set))
  (if set (setf (slot-value 'overlay) list))
  (slot-value 'overlay))

(defmeth regress-plot-proto :coefs (&optional (list nil set))
  (if set (setf (slot-value 'coefs) list))
  (slot-value 'coefs))

(defmeth regress-plot-proto :origcoefs (&optional (list nil set))
  (if set (setf (slot-value 'origcoefs) list))
  (slot-value 'origcoefs))

(defmeth regress-plot-proto :isnew                                       
         (data &key (show t) (title "Reg Demo") location size (go-away t)       
         variable-labels)                                                
  (let ((g (call-next-method                                          
            (length data) :show nil :title title                         
            :location location :size size :go-away go-away               
            :variable-labels variable-labels)))
    (send self :data data)
    (send self :add-points data)                                       
    (send self :adjust-to-data)                                          
    (send self :add-mouse-mode 'point-moving                             
          :title "Leverage"                                          
          :cursor 'finger                                                
          :motion :do-actions)                                           
    
   ; (send self :add-mouse-mode 'line-moving                              
   ;       :title "Line Moving"                                           
   ;       :cursor 'finger                                                
   ;       :motion :do-actions)                                           
    
    (send self :add-mouse-mode 'restricting-range                        
          :title "Range Restriction"                                     
          :cursor 'finger                                                
          :motion :do-actions)                  
    (send self :mouse-mode 'point-moving)                                
    (send self :set-regression-line)                                     
    (send self :add-margin) 
    (send self :overlay (make-reg-overlay))
    (send self :add-overlay (send self :overlay))                        
    (when show (send self :show-window))                                 
    )                                                                    
  )    

;OBJECT METHODS                                                          
  
(defmeth regress-plot-proto :add-margin ()                               
  (let ((h (+ (send self :text-ascent) (send self :text-descent)))       
        )                                                                
  (send self :margin 0 0 0 (round (* 3.0 h)))))                        
  
               
(defmeth regress-plot-proto :do-actions (x y)  
 
  (when (or (not (< 0 x (first (send self :size))))
            (not (< 0 y (second (send self :size)))))
        (setf x (first (send self :content-rect)))
        (setf y (second (send self :content-rect))))
  (let ((mm (send self :mouse-mode))                                     
        (p  nil))                                                        
    (cond                                                                
      ((equal mm 'point-moving)  
       (send self :point-state (iseq (send self :num-points)) 'normal)
       (send self :redraw)
       (setf p (send self :drag-point x y :draw nil))                      
       (if p (send self :set-regression-line)))                          
      ((equal mm 'restricting-range)                                     
       (send self :restrict-range x y)                                   
       )                                                                   
      )))                                                              
  
  
(defmeth regress-plot-proto :restrict-range (x y)                        
  (let ((cr (send self :content-rect))                                   
        (coefs (send self :calculate-coefficients x ))) 
    (send self :clear-lines :draw nil) 
    (when coefs  
          (send self :coefs coefs)
          (send self :abline (select coefs 0) (select coefs 1)))               
    (when (< (first cr) x (+ (first cr) (third cr)))                     
          (send self :draw-line x (second cr) x 
                (+ (second cr) (fourth cr))))
    (send self :redraw))
    )

(defmeth regress-plot-proto :set-regression-line ()                      
  (let ((coefs (send self :calculate-coefficients))
        (origcoefs (send self :original-coefficients)))
    (send self :origcoefs origcoefs)
    (format t "~5,2f ~5,2f~%" (first coefs) (second coefs)) 
    (send self :coefs coefs)   
    (send self :redraw t)
    (send self :clear-lines :draw nil)                                   
    (send self :abline (select coefs 0) (select coefs 1))
    ))    

(defmeth regress-plot-proto :original-coefficients ()
  (let* (
         (data (send self :data))
         (rm (regression-model (first data) (second data) :print nil)))
    (combine (send rm :coef-estimates) (sqrt (send rm :r-squared)))))
         
(defmeth regress-plot-proto :calculate-coefficients (&optional
restrict-x)                      
  (let* ((mm (send self :mouse-mode))
         (i (iseq 0 (- (send self :num-points) 1)))
         (x (send self :point-coordinate 0 i))
         (y (send self :point-coordinate 1 i))
         (cutoff-x nil)
         (nobs (send self :num-points))
         (selected-obs nil)
         (deselected-obs nil)
         (m nil))
    
    (cond
      ((equal mm 'point-moving)
       (setf m (regression-model x y :print nil))
       (if m (combine (send m :coef-estimates) (sqrt (send m :r-squared)))))
      ((equal mm 'restricting-range)
       (setf cutoff-x (first (send self :canvas-to-real restrict-x 1)))
       (when (> restrict-x 0)
             (setf selected-obs (which (< cutoff-x x)))
             (setf deselected-obs (which (> cutoff-x x)))
             (send self :point-state (iseq nobs) 'normal)
             (when deselected-obs 
                   (send self :point-state deselected-obs 'invisible))
             (when (> (length selected-obs) 1)
                   (setf m (regression-model (select x selected-obs) 
                                             (select y selected-obs) :print nil))
                   (if m (combine (send m :coef-estimates) 
                                  (sqrt (send m :r-squared))))))))
    ))
                                                                         
(defmeth regress-plot-proto :adjust-screen ()                            
  (if (send self :needs-adjusting)                                       
      (send self :set-regression-line))                                    
  (call-next-method))         

;CONSTRUCTOR FUNCTION AND DEFPROTO (FOR REGRESS-OVERLAY-PROTO):          
                                                                         
(defun make-reg-overlay ( )                                              
  (send regress-overlay-proto :new))                                                                                                              
  
(defproto regress-overlay-proto '() () graph-overlay-proto)    

(defmeth regress-overlay-proto :redraw (&optional flag)                                  
  (let* ((graph (send self :graph))                                      
         (coefs (send graph :coefs))
         (origcoefs (send graph :origcoefs))
         (cr (send graph :content-rect))                                 
         (text-height (+ (send graph :text-ascent)                       
                         (send graph :text-descent)))                    
         (line0 (- (send graph :canvas-height)                           
                   (round (* 3 text-height)) 5))                           
         (line1 (+ line0 text-height))                                   
         (line2 (+ line1 text-height))                                   
         (line3 (+ line2 text-height))       
         (indent 15)                                                     
         (gap 15)                                                        
         (tw1 (send graph :text-width "Original "))                      
         (tw2 (send graph :text-width " 3.33 "))                         
         (tw3 (send graph :text-width " y= a.aa + b.bbx "))              
         (x1 (+ indent tw1 gap (floor (/ tw2 2))))                       
         (x2 (+ x1 gap (floor (/ (+ tw2 tw3) 2))))
         )                                                               
    (send graph :draw-line    0 line0 (send graph :canvas-width) line0)  
    (send graph :draw-text   "R" x1 line1  1 0)                          
    (send graph :draw-text   "Equation" x2 line1 1 0)                    
    (send graph :draw-string "Original:" indent line2)                   
    (send graph :draw-string "Current:" indent line3)                       
    (send graph :draw-text   
          (FORMAT NIL "~5,3f" (THIRD COEFS))
          x1 line3 1 0)                            
    (send graph :draw-text   
          (format nil "~5,3f" (third origcoefs))
          x1 line2  1 0)                           
    (send graph :draw-text   
          (format nil "  y= ~5,2f + ~5,2fx" (first coefs) (second coefs))
          x2 line3  1 0)
    (send graph :draw-text 
          (format nil "  y= ~5,2f + ~5,2fx" (first origcoefs) (second
origcoefs))
          x2 line2  1 0)))    

;You can use the next statement to test the code: 

(vista-message "This Applet demonstrates restriction of range on the value of the correlation coefficient.

The original and current values of the coefficient are shown in the bottom part of the graph window, along with the equation for drawing the regression line. As you move your cursor back and forth, the current correlation coefficient value varies, as does the regression line." :title "Restricition of Range")

(setf test (reg-plot (list  mathsat gpa ) 
                      :show t :title "Restriction of Range"
                      :variable-labels '( "MathSAT" "GPA")
                      :location '(100 200) :size '(300 300)))   

(send test :mouse-mode 'restricting-range)