#|

     class18.lsp   

    - simple robust estimator object.

    - Elements that support event-driven programming.
    
    - Primitive sensitivity analyzer.

|#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                         ;;
;;    Defining a robust estimator prototype.               ;;
;;                                                         ;;
;;                                 Tierney, Chapter 6      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
;---  Define the prototype first  (can skip common slot/parent in this case)

  (defproto robust-proto 
    '(psi w value   ; single parent is 'mother' of all objects  
     ) 
    )

  (defmeth robust-proto :ISNEW (psi)
    (setf (slot-value 'psi) psi)
    (setf (slot-value 'w)
          #'(lambda (x)
              (if (zerop x) 1
                  (/ (funcall psi x) x))))
    )

  (defmeth robust-proto :CALCULATE (data &key (tol .01))
    (do* ((i     0
                 (1+ i))
          (wts   (repeat 1 (length data))
                 (mapcar (slot-value 'w) (- data mu)))
          (prior -1111
                 mu)
          (mu    (mean data)
                 (/ (inner-product wts data)
                    (sum wts)))
          )
         ((< 5 i) mu)
         (format t "#~d: ~8,3f ~8,3f~%" i mu prior)
         ; (format t "Wts = ~a~%" wts)
         ))

 ; (or (< 5 i) (< (abs (- prior mu)) tol))  mu)


   (defmeth robust-proto :PLOT-PSI ()
     (plot-function (slot-value 'psi) -2 2)
     )

   (defmeth robust-proto :PLOT-W ()
     (plot-function (slot-value 'w) -2 2)
     )
               

#| 
;--- Examples of use

 (def r (send robust-proto :new #'identity ))
 (send r :plot-psi)
 (send r :plot-w)
 (send r :calculate '(1 2 3 4 5) :tol .01)

 (def r (send robust-proto :new 
              #'(lambda (x)  (if (< -1 x 1)
                                 (* x (^ (- 1 (* x x)) 2))
                                 0))))
 (send r :plot-psi)
 (send r :plot-w)
 (send r :calculate '(1 2 3 4 5) :tol .01)


|#  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                         ;;
;;    Exploring LispStat's graphics objects.               ;;
;;                                                         ;;
;;                              Tierney, Chapter 8         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


#|
      
;--- Define a new type of window

  (defproto STRING-WINDOW-PROTO 
    '(cx cy string)
    '()
    graph-window-proto)

  (defmeth string-window-proto :STRING (s)
    (setf (slot-value 'string) s)
    (send self :resize)
    (send self :redraw)
    )

  (defmeth string-window-proto :RESIZE ()   ;override prior
    (setf (slot-value 'cx) (round (/ (send self :canvas-width) 2)))
    (setf (slot-value 'cy) (round (/ (send self :canvas-height) 2)))
    )

  (defmeth string-window-proto :REDRAW ()
    (when (slot-value 'string)
          (send self :draw-color
                (elt *colors* (random (length *colors*))))
          (send self :draw-text (slot-value 'string)
                (slot-value 'cx) (slot-value 'cy)
                1 1)
          ))

#|
  
;--- Create string window

  (def sw (send string-window-proto :new))

  (send sw :string "Test String")


;--- Mouse tracking via the DO-MOTION, DO-CLICK methods

  (defmeth sw :DO-MOTION (x y)
    (setf (slot-value 'cx) x)
    (setf (slot-value 'cy) y)
    (send self :redraw)
    )

  (send sw :delete-method :do-motion)

  (defmeth sw :DO-CLICK (x y s o)
    (setf (slot-value 'cx) x)
    (setf (slot-value 'cy) y)
    (if s (send self :erase-window))
    (send self :redraw)
    )

  (defmeth sw :DO-CLICK (x y s o)
    (let ((old (send self :cursor))  )
      (send self :cursor 'hand)
      (flet ((tracker (x y)
                      (setf (slot-value 'cx) x)
                      (setf (slot-value 'cy) y)
                      (if s (send self :erase-window))
                      (send self :redraw))  )
        (tracker x y)
        (send self :while-button-down #'tracker))
      (send self :cursor old)
      ))

|#
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                         ;;
;;    Dragging a point in the window.                      ;;
;;                                                         ;;
;;                              Tierney, Chapter 8         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  (defproto ESTIMATOR-WINDOW-PROTO 
    '(estimator data drawnAt)
    '()
    graph-window-proto)

 
  (defmeth estimator-window-proto :ISNEW (data est)
    (setf (slot-value 'estimator) est)
    (setf (slot-value 'data) data)
    (send self :size 200 100)
    (call-next-method)    ; vip
    )

  (defmeth estimator-window-proto :REDRAW ()
    (dolist (x (slot-value 'data))
            (send self :draw-symbol 'dot4 nil x 50)
            )
    (send self :draw-estimator)
    )

  (defmeth estimator-window-proto :DRAW-ESTIMATOR (&optional x)
    (let ((est (round (if x x (send self :estimator-value)))) )
      (setf (slot-value 'drawnAt) est)
      (send self :draw-line est 25 est 75)
      ))
    
  (defmeth estimator-window-proto :ESTIMATOR-VALUE (&optional x)
    (funcall (slot-value 'estimator)
             (if x (cons x (slot-value 'data))
                 (slot-value 'data))
             ))
 
  (defmeth estimator-window-proto :DO-CLICK (x y s o)
    (let ((curs (send self :cursor))
          (old  (send self :estimator-value))  )
      (send self :cursor 'hand)
      (flet ((tracker (x y)
                      (send self :draw-estimator (slot-value 'drawnAt))
                      (send self :draw-estimator
                            (send self :estimator-value x))   )
             )
        (send self :draw-mode 'xor)
        (send self :while-button-down #'tracker)
        (send self :draw-mode 'normal)
        (send self :cursor curs)
        )))

#|

 (def ew (send estimator-window-proto :new
               '(20 40 60 80 100) #'mean))

 (def ew (send estimator-window-proto :new
               '(20 40 60 80 100) #'median))


|#