(defmeth dialog-proto :close () (exit) ) (setf data '( (1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990) (9.130000000000001 5.28 4.2 4.6 7.15 9.699999999999999 5.02 6.7 10.5 9.1 8.75 8.1 3.75 10.15 6.15 12.75 7.35 11.25 4.05 12.65 4.65 5.35 4.05 5.9 9.449999999999999 3.45 4.25 7.9 9.380000000000001 7.08 11.92 3.88 5.8 2.7 18.08 8.199999999999999 7.65 5.22 4.93 5.99 6.83 8.800000000000001 7.1) (3.58 4.82 3.77 4.46 4.99 5.65 1.45 7.44 5.85 6.13 5.23 3.77 1.47 5.09 3.52 8.17 4.33 6.56 1.9 6.62 3.84 3.62 1.98 5.72 4.82 2.63 2.54 4.42 8.300000000000001 4.4 5.78 2.26 3.1 2.22 11.96 4.98 5.3 4.42 3.26 2.76 6.82 5.06 5.06) (3.91 5.2 3.67 3.93 4.88 4.91 1.77 6.51 3.38 4.08 5.9 4.56 1.78 4.86 3.3 10.16 4.85 7.6 2.0 7.14 3.34 4.62 2.94 5.42 6.79 2.88 2.36 6.78 9.699999999999999 3.9 6.7 3.1 3.34 2.48 13.02 5.76 5.74 4.04 4.58 3.98 5.18 4.92 6.05) (4.1 7.55 9.52 11.14 16.34 8.880000000000001 13.57 9.279999999999999 21.2 9.550000000000001 15.25 9.050000000000001 4.57 8.9 16.9 16.75 5.25 8.4 10.85 23.25 7.1 43.37 8.949999999999999 8.449999999999999 7.9 14.8 18.05 11.5 6.8 4.05 25.3 15.97 24.4 8.99 18.55 19.25 14.45 11.45 26.47 4.8 7.2 8.050000000000001 5.8) (7.43 11.11 12.2 15.15 20.05 8.15 12.45 9.65 18.55 9.199999999999999 14.8 6.85 6.1 7.15 14.75 11.55 7.45 13.2 8.25 17.0 6.8 24.85 11.25 10.9 7.6 14.7 16.9 9.550000000000001 5.25 4.35 20.55 11.83 19.15 9.449999999999999 18.4 22.9 13.15 10.16 15.33 6.85 9.01 9.6 6.5) (6.47 10.26 11.35 11.13 22.81 7.41 13.32 9.800000000000001 17.42 8.25 17.48 9.56 7.65 9.0 17.68 15.53 8.199999999999999 13.29 12.56 23.66 8.279999999999999 33.07 11.0 10.82 8.06 15.86 16.42 12.56 4.73 4.6 21.94 13.88 23.78 12.14 19.45 23.86 14.42 13.06 26.46 6.36 9.880000000000001 9.58 8.41) (54235 67567 66161 68094 107080 67594 65356 67909 92715 70024 99216 55786 46153 47947 76877 88443 54634 78806 56542 116244 60857 146345 73726 65530 60772 91696 87377 77306 44756 41785 112653 79975 106821 69177 120463 135043 102001 77790 118144 61229 58942 53965 49774))) (defun start () (let* ( ; (data (read-data-columns "DWP.data")) (n (length (first data))) (newreg t) (varind (repeat nil 7)) (newplot1 t) (newplot2 t) (newplot3 t) (newplot4 t) (update nil) (goodpts (iseq (length (first data)))) ) (let* ( (deptell (send text-item-proto :new "Dependent Variable: BSAAM")) (indepask (send text-item-proto :new "Pick Regressors: ")) (interceptask (send toggle-item-proto :new "Intercept")) (dateask (send toggle-item-proto :new "YEAR")) (apmamask (send toggle-item-proto :new "APMAM")) (apsabask (send toggle-item-proto :new "APSAB")) (apslakeask (send toggle-item-proto :new "APSLAKE")) (opbpcask (send toggle-item-proto :new "OPBPC")) (oprcask (send toggle-item-proto :new "OPRC")) (opslakeask (send toggle-item-proto :new "OPSLAKE")) (reprintask (send toggle-item-proto :new "Reprint Plots?")) (includeask (send toggle-item-proto :new "Include All Points?")) (plotask (send text-item-proto :new "Choose Diagnostics: ")) (indepvsdepask (send toggle-item-proto :new "Dependent vs. Independent")) (residvsfitask (send toggle-item-proto :new "Residuals vs. BSAAM")) (residvstimeask (send toggle-item-proto :new "Residuals vs. Time")) (studentask (send toggle-item-proto :new "Studentized Residuals vs. BSAAM")) (cpksask (send toggle-item-proto :new "CP vs. Number of Regressors")) (varlist (list "Year" "Apmam" "Apsab" "Apslake" "Opbpc" "Oprc" "Opslake")) (do-it (send button-item-proto :new "Compute Regression" :action #'(lambda () (let* ( (interceptans (send interceptask :value)) (dateans (send dateask :value)) (apmamans (send apmamask :value)) (apsabans (send apsabask :value)) (apslakeans (send apslakeask :value)) (opbpcans (send opbpcask :value)) (oprcans (send oprcask :value)) (opslakeans (send opslakeask :value)) (indepvsdep (send indepvsdepask :value)) (residvsfit (send residvsfitask :value)) (residvstime (send residvstimeask :value)) (student (send studentask :value)) (reprintans (send reprintask :value)) (includeans (send includeask :value)) (numreg (length (which (list dateans apmamans apsabans apslakeans opbpcans oprcans opslakeans)))) (newplot1 (if (= 7 (length (which (map-elements #'(lambda (x y) (equalp x y)) varind (list dateans apmamans apsabans apslakeans opbpcans oprcans opslakeans))))) nil t)) (goodpts (cond (includeans (repeat t n)) ((and (not newreg) (not (= 0 (length (variables))))) (send (elt (mapcar #'symbol-value (variables)) (first (which (mapcar #'objectp (mapcar #'symbol-value (variables)))))) :point-showing (iseq n))) (t (repeat t n)))) (newplot2 newplot1) (newplot3 newplot2) (newplot4 newplot3) (update (if (or includeans (/= (length (which goodpts)) n)) t nil)) ) (setf varind (list dateans apmamans apsabans apslakeans opbpcans oprcans opslakeans)) (cond (reprintans (setf newplot1 t) (setf newplot2 t) (setf newplot3 t) (setf newplot4 t))) (cond (newreg (setf reg1 (regression-model (select data (which varind)) (elt data 7) :intercept interceptans :print nil))) (t (send reg1 :intercept interceptans) (send reg1 :x (matrix (list n numreg) (combine (transpose (select data (which varind)))))) (send reg1 :included goodpts) (send reg1 :compute))) (send reg1 :predictor-names (select varlist (which varind))) (send reg1 :response-name "Bsaam") (send reg1 :display) (setf newreg nil) (cond ((and newplot1 indepvsdep) (cond (dateans (def dateplot (plot-points (elt data 0) (elt data 7) :title "BSAAM vs. TIME" :variable-labels (list "TIME" "BSAAM"))) (send dateplot :linked t))) (cond (apmamans (def apmamplot (plot-points (elt data 1) (elt data 7) :title "BSAAM vs. APMAM" :variable-labels (list "APMAM" "BSAAM"))) (send apmamplot :linked t))) (cond (apsabans (def apsabplot (plot-points (elt data 2) (elt data 7) :title "BSAAM vs. APSAB" :variable-labels (list "APSAB" "BSAAM"))) (send apsabplot :linked t))) (cond (apslakeans (def apslakeplot (plot-points (elt data 3) (elt data 7) :title "BSAAM vs. ASPLAKE" :variable-labels (list "APSLAKE" "BSAAM"))) (send apslakeplot :linked t))) (cond (opbpcans (def opbpcplot (plot-points (elt data 4) (elt data 7) :title "BSAAM vs. OPBPC" :variable-labels (list "OPBPC" "BSAAM"))) (send opbpcplot :linked t))) (cond (oprcans (def oprcplot (plot-points (elt data 5) (elt data 7) :title "BSAAM vs. OPRC" :variable-labels (list "OPRC" "BSAAM"))) (send oprcplot :linked t))) (cond (opslakeans (def opslakeplot (plot-points (elt data 6) (elt data 7) :title "BSAAM vs. OPSLAKE" :variable-labels (list "OPSLAKE" "BSAAM"))) (send opslakeplot :linked t))))) (cond ((and indepvsdep update) (if dateans (refresh-plot (elt data 0) (elt data 7) goodpts dateplot)) (if apmamans (refresh-plot (elt data 1) (elt data 7) goodpts apmamplot)) (if apsabans (refresh-plot (elt data 2) (elt data 7) goodpts apsabplot)) (if apslakeans (refresh-plot (elt data 3) (elt data 7) goodpts apslakeplot)) (if opbpcans (refresh-plot (elt data 4) (elt data 7) goodpts opbpcplot)) (if oprcans (refresh-plot (elt data 5) (elt data 7) goodpts oprcplot)) (if opslakeans (refresh-plot (elt data 6) (elt data 7) goodpts opslakeplot)))) (cond (residvsfit (cond ((and newplot2 residvsfit) (def residvsfitplot (plot-points (select (send reg1 :fit-values) (which goodpts)) (send reg1 :residuals) :title "Residuals vs. Predicted BSAAM" :variable-labels (list "Predicted BSAAM" "Residuals"))) (send residvsfitplot :linked t) (setf newplot2 nil)) (update (let ( (x (select (send reg1 :fit-values) (which goodpts))) (y (select (send reg1 :residuals) (which goodpts))) ) (send residvsfitplot :clear-points) (send residvsfitplot :add-points x y) (send residvsfitplot :adjust-to-data) ))))) (cond (residvstime (cond ((and newplot3 residvstime) (def rvstimeplot (plot-points (select (elt data 0) (which goodpts)) (send reg1 :residuals) :title "Residuals vs. TIME" :variable-labels (list "Time" "Residuals"))) (send rvstimeplot :linked t) (setf newplot3 nil)) (update (let ( (x (select (elt data 0) (which goodpts))) (y (select (send reg1 :residuals) (which goodpts))) ) (send rvstimeplot :clear-points) (send rvstimeplot :add-points x y) (send rvstimeplot :adjust-to-data) ))))) (cond (student (cond ((and newplot4 student) (def studentplot (plot-points (select (send reg1 :fit-values) (which goodpts)) (select (send reg1 :studentized-residuals) (which goodpts)) :title "Studentized Residuals vs Predicted BSAAM" :variable-labels (list "Predicted BSAAM" "Studentized Residuals"))) (send studentplot :linked t) (setf newplot4 nil)) (update (let ( (x (select (send reg1 :fit-values) (which goodpts))) (y (select (send reg1 :studentized-residuals) (which goodpts))) ) (print (list (length x) (length y))) (send studentplot :clear-points) (send studentplot :add-points x y) (send studentplot :adjust-to-data) ))))))))) ) (send dialog-proto :new (list (list deptell) (list indepask) (list interceptask) (list dateask) (list apmamask) (list apsabask) (list apslakeask) (list opbpcask) (list oprcask) (list opslakeask) (list plotask) (list indepvsdepask) (list residvsfitask) (list residvstimeask) (list studentask) (list do-it) (list reprintask) (list includeask))) ) ) ) #| (defmeth dialog-proto :close () (exit) ) |# (start) (defmeth scatterplot-proto :close () (call-next-method) (let ( (vars (variables)) (varplot (first (which (mapcar #'(lambda (x) (equalp x self)) (mapcar #'symbol-value (variables)))))) ) (undef (elt vars varplot)) ) ) (defun refresh-plot (data1 data2 goodpts plot) (let ( (x (select data1 (which goodpts))) (y (select data2 (which goodpts))) ) (send plot :clear-points) (send plot :add-points x y) (send plot :adjust-to-data) ) )