;; This program is written by Dr. Alex Yu to illustrate the relationship
;; between outliers and central tendencies--mean, medium, and mode. 
;; It is a popular belief that at the presence of outliers the mean skews
;; towards the outliers, the mode is most robust and the medium is between the 
;; previous two. Actually in many cases even there are quite a few outliers and
;; the outliers are very extreme, the medium and mode are still in the same
;; location.
 
  

;; plot a normally distributed curve
(setq data-x (list 1 2 2 3 3 3 4 4 4 4 5 5 5 5 5 6 6 6 6 7 7 7 8 8 9))
(setf h1 (histogram data-x))
(send h1 :num-bins 15)
(send h1 :size 300 200)
(send h1 :location 2 37)

(defun draw-mean (data)
  (setq m1 (mean data))
  (setq point1 (car (send h1 :scaled-to-canvas m1 0)))
  (setq point2 (car (cdr (send h1 :scaled-to-canvas m1 0))))
  (setq point3 (car (send h1 :scaled-to-canvas m1 5)))
  (setq point4 (car (cdr (send h1 :scaled-to-canvas m1 5))))
  (send h1 :draw-color 'red)
  (send h1 :draw-line point1 point2 point3 point4)
  (send h1 :draw-color 'black))

(defun draw-median (data)
  (setq md1 (median data))
  (setq pointa (car (send h1 :scaled-to-canvas md1 0)))
  (setq pointb (car (cdr (send h1 :scaled-to-canvas md1 0))))
  (setq pointc (car (send h1 :scaled-to-canvas md1 5)))
  (setq pointd (car (cdr (send h1 :scaled-to-canvas md1 5))))
  (send h1 :draw-color 'green)
  (send h1 :draw-line pointa pointb pointc pointd)
  (send h1 :draw-color 'black))

(defun draw-mode ()
  (setq pointp (car (send h1 :scaled-to-canvas 5 0)))
  (setq pointq (car (cdr (send h1 :scaled-to-canvas 5 0))))
  (setq pointr (car (send h1 :scaled-to-canvas 5 5)))
  (setq points (car (cdr (send h1 :scaled-to-canvas 5 5))))
  (send h1 :draw-color 'blue)
  (send h1 :draw-line pointp pointq pointr points)
  (send h1 :draw-color 'black))

(defun reset ()
  (send h1 :remove)
  (setq data-x (list 1 2 2 3 3 3 4 4 4 4 5 5 5 5 5 6 6 6 6 7 7 7 8 8 9))
  (setf h1 (histogram data-x))
  (send h1 :num-bins 15)
  (send h1 :size 300 200)
  (send h1 :location 2 37))

(defun clear ()
  (send h1 :redraw))

;;prompt the user enter an extreme score and replot the curve
(defun outlier ()
  (setq b (car (get-value-dialog
          "Enter an extreme score, then press RETURN")))
  (loop
   (cond
     ((not (numberp b))
      (setq b (car (get-value-dialog 
          "Incorrect value. Enter a number:"))))
   (t (return t))))
  (send h1 :remove)
  (setq data-new (cons b data-x))
  (setq data-x (reverse data-new))
  (setf h1 (histogram data-x))
  (send h1 :num-bins 15)
  (send h1 :size 300 200)
  (send h1 :location 2 37))

(defun add-outliers ()
  (setq list1 (get-string-dialog 
               "Enter a set of extreme scores within the parentheis:         " 
               :initial "(            )"))
  (setq listx (with-input-from-string (s list1) (read s)))
  (loop
   (cond
     ((not (listp listx))
      (setq list1 (get-string-dialog 
                   "Incorrect, enter numbers within the bracket like this: (15 12 13 14)" 
                   :initial "(            )"))
      (setq listx (with-input-from-string (s list1) (read s))))
     (t (return t))))
  (send h1 :remove)
  (setq data-new2 (append listx data-x))
  (setq data-x (reverse data-new2))
  (setf h1 (histogram data-x))
  (send h1 :num-bins 15)
  (send h1 :size 300 200)
  (send h1 :location 2 37))

;make a pull-down menu
(setf pull-menu (send menu-proto :new "Alter"))
(setf item1
        (send menu-item-proto :new "Add an Outlier"
              :action #'(lambda ()
                                 (outlier)))) 
(setf item2
        (send menu-item-proto :new "Add Outliers"
              :action #'(lambda ()
                                 (add-outliers)))) 

(setf item3
        (send menu-item-proto :new "Reset"
              :action #'(lambda ()
                                 (reset)))) 


(send pull-menu :append-items item1 item2 item3)
(send pull-menu :install)



(setf central (send choice-item-proto :new
                 (list "Show mean (Red)" 
                       "Show median (Green)"
                       "Show mode (Blue)"
                        "Clear") :value 1))
  
  (setf header (send text-item-proto :new 
                   "Show Central Tendenies"))

  (setf ok (send button-item-proto :new "OK" :action
                  #'(lambda ()
                     (let ((position (send central :value)))
                      (case position 
                        (0 (draw-mean data-x))
                        (1 (draw-median data-x))
                        (2 (draw-mode))
                        (3 (clear)))))))  

  (setf choices (send dialog-proto :new
                   (list header central ok)))

(send choices :show nil)
(send choices :location 305 37)
(send choices :size 180 168)