(defun read-list-char (file) (do ((char-list nil (append char-list (list new-char))) (new-char (read-char file) (read-char file))) ((or (eql new-char #\Newline) (null new-char)) char-list))) ;(append char-list (list #\Space #\Space #\Space #\Space)) ))) (defun write-list-char (char-list file) (dolist (char char-list) (write-char char file)) (write-char #\Space file)) (defun read-select-write (ind in-stream out-stream) (let* ((line (read-list-char in-stream)) (char-lists (if line (mapcar #'(lambda (i) (select line i)) ind)))) (dolist (char-list char-lists line) (write-list-char char-list out-stream)))) (defun grab-nels88 (sex-ind ind1 ind2 ind3 out-file) (let ((sex (open "sexrace.dat")) (f (open "nels88_2.dat")) (out (open out-file :direction :output))) (loop (unless (read-select-write sex-ind sex out) (return)) (read-select-write ind1 f out) (read-select-write ind2 f out) (read-select-write ind3 f out) (write-char #\Newline out)) (write-char #\Newline out) (close sex) (close f) (close out))) ;(grab-nels88 (list (iseq 0 4) '(5 6) '(8) '(10)) ;(list '(7) '(8) '(9) '(10) '(11) '(12) ;'(13 14) '(15 16) '(17 18) '(19 20) '(21 22) '(23 24) '(25 26) ;'(27) (iseq 28 36) '(37) (iseq 39 44) '(45) '(46 47) ;'(48) '(49) (iseq 50 56) (iseq 57 63) (iseq 64 70) (iseq 71 76)) ;(list `(7 8) '(9) '(10) '(11) '(12) '(13) '(14) '(15) '(16) '(17) '(18) ;'(19) '(20) '(21) '(22) '(23) '(24) '(25) '(26) '(27) '(28) '(29) '(30 31)) ;nil ;"nels88-stud.dat") ;(grab-nels88 nil (list (iseq 0 4) '(38)) nil ; (append (mapcar #'list (iseq 7 32)) (list (iseq 33 41)) ; (mapcar #'list (iseq 42 48)) (list '(49 50))) ; "nels88-schl.dat") (def stud-vars (list "School ID" "Student ID" "Sex" "Race" "BYS35B" "BYS35C" "BYS35D" "BYS35E" "BYS35F" "BYS35M" "BYS48A" "BYS48B" "BYS79A" "BYS79B" "BYS79C" "BYS79D" "BYS79E" "BYS80" "BYQWT" "BYIEPFLG" "BYSES" "BYPARED" "BYFAMSIZ" "BYFCOMP" "BYHMLANG" "BYTXRSTD" "BYTXMSTD" "BYTXSSTD" "BYTXHSTD" "BYP6" "BYP38A" "BYP38B" "BYP38C" "BYP38D" "BYP44" "BYP58A" "BYP58B" "BYP58C" "BYP58D" "BYP58E" "BYP58F" "BYP59A" "BYP59B" "BYP59C" "BYP59D" "BYP59E" "BYP65A" "BYP65B" "BYP66" "BYP67" "BYP69" "BYP72" )) (def stud-vars-symbols (list 'School-ID 'Student-ID 'Sex 'Race 'BYS35B 'BYS35C 'BYS35D 'BYS35E 'BYS35F 'BYS35M 'BYS48A 'BYS48B 'BYS79A 'BYS79B 'BYS79C 'BYS79D 'BYS79E 'BYS80 'BYQWT 'BYIEPFLG 'BYSES 'BYPARED 'BYFAMSIZ 'BYFCOMP 'BYHMLANG 'BYTXRSTD 'BYTXMSTD 'BYTXSSTD 'BYTXHSTD 'BYP6 'BYP38A 'BYP38B 'BYP38C 'BYP38D 'BYP44 'BYP58A 'BYP58B 'BYP58C 'BYP58D 'BYP58E 'BYP58F 'BYP59A 'BYP59B 'BYP59C 'BYP59D 'BYP59E 'BYP65A 'BYP65B 'BYP66 'BYP67 'BYP69 'BYP72 )) (def school-vars (list "School ID" "G8CTRL" "BYSC47A" "BYSC47B" "BYSC47C" "BYSC47D" "BYSC47E" "BYSC47F" "BYSC47G" "BYSC47H" "BYSC47I" "BYSC47J" "BYSC47K" "BYSC47L" "BYSC47M" "BYSC47N" "BYSC47O" "BYSC49A" "BYSC49B" "BYSC49C" "BYSC49D" "BYSC49E" "BYSC49F" "BYSC49G" "BYSC49H" "BYSC49I" "BYSC49J" "BYSC49K" "BYADMWT" "G8TYPE" "BYSCENRL" "G8ENROL" "G8URBAN" "G8REGON" "G8MINOR" "G8LUNCH" "BYRATIO")) (def school-vars-symbols (list 'School-ID 'G8CTRL 'BYSC47A 'BYSC47B 'BYSC47C 'BYSC47D 'BYSC47E 'BYSC47F 'BYSC47G 'BYSC47H 'BYSC47I 'BYSC47J 'BYSC47K 'BYSC47L 'BYSC47M 'BYSC47N 'BYSC47O 'BYSC49A 'BYSC49B 'BYSC49C 'BYSC49D 'BYSC49E 'BYSC49F 'BYSC49G 'BYSC49H 'BYSC49I 'BYSC49J 'BYSC49K 'BYADMWT 'G8TYPE 'BYSCENRL 'G8ENROL 'G8URBAN 'G8REGON 'G8MINOR 'G8LUNCH 'BYRATIO)) ; grab-cases deletes redundant school lines (defun grab-cases (casep length in-file out-file) (let ((f (open in-file)) (out (open out-file :direction :output)) (ind (list (iseq length)))) (dolist (p casep) (if p (list (read-select-write ind f out) (write-char #\Newline out)) (read-list-char f))))) ;(if-else (mapcar #'(lambda (x) (equalp 0 x)) case) nil t)) ;(def casep *) ;(savevar 'casep "casep) ;(load "casep") ;(grab-cases casep 87 "nels88-schl.dat" "nels88-school.dat") (defun read-selected (var-labels file) (let* ((ind (choose-subset-dialog "Choose Variables" var-labels)) (data (select (read-data-columns file (length var-labels) ind))) (vars (select var-labels ind))) (list vars data))) (defun school-data () (let* ((data (read-data-columns "nels88-school.dat" (length school-vars))) (la (send list-item-proto :new school-vars)) (ok (send modal-button-proto :new "Enough!")) (the-dialog (send modal-dialog-proto :new (list la ok)))) (send ok :action #'(lambda () (send the-dialog :close))) (send la :action #'(lambda (x) (unless x (let* ((i (send la :selection)) (var (elt data i)) (label (elt school-vars i)) (symbol (elt school-vars-symbols i))) (setf (symbol-value symbol) var) (format t "~a is now bound as ~a~%" label (symbol-name symbol)))))) the-dialog)) (defun stud-data () (let* ((data (read-data-columns "nels88-stud.dat" (length stud-vars))) (la (send list-item-proto :new stud-vars)) (ok (send modal-button-proto :new "Enough!")) (the-dialog (send modal-dialog-proto :new (list la ok)))) (send ok :action #'(lambda () (send the-dialog :close))) (send la :action #'(lambda (x) (unless x (let* ((i (send la :selection)) (var (elt data i)) (label (elt stud-vars i)) (symbol (elt stud-vars-symbols i))) (setf (symbol-value symbol) var) (format t "~a is now bound as ~a~%" label (symbol-name symbol)))))) the-dialog))