;;; This file holds all the procedures for saving information to files. ;;; Close and open files (log file with div, speciation, extinct levels) ;;; recording stuff (run-number, max-div, speciation, extinction, mutatation, ;;; amount-selection, actual-selection, turn-over? ;;; before-taxa-numbers, after-sel-taxa-numbers, ;;; after-random-taxa-numbers, percentage-extinctions ;;; for taxa in different conditions) (in-package 'USER) ;(defvar *sel-log-file* ()) ; holds the events over time. (defvar *rand-log-file* ()) ; holds the events over time. (defvar *div-file* ()) ; holds the diversity records over time. (defun open-files () (when *save-info* (setf *rand-log-file* (open (format () "output/run-~a-rand.log" *run-number*) :direction :output :if-does-not-exist :create :if-exists :overwrite)) (setf *sample-file* (open (format () "output/trees/lineage/sampling-~a.txt" *run-number*) :direction :output :if-does-not-exist :create :if-exists :overwrite)))) (defun close-files () ;(unless (null *sel-log-file*) (close *sel-log-file*)) ;(unless (null *div-file*) (close *div-file*)) (unless (null *sample-file*) (close *sample-file*)) (unless (null *rand-log-file*) (close *rand-log-file*))) (defun save-header () (format *rand-log-file* "# Run ~a N = ~a Mass extinction schedule: ~a~%" *run-number* *max-diversity* *extinct-sched*) (format *rand-log-file* "# Speciation: ~,5,,,F Extinction: ~,5,,,F~%" (/ *speciation* (* 1.0 PROBSCALE)) (/ *extinction* (* 1.0 PROBSCALE)))) (defun record-diversity (num-spec origs extincts &optional (select ())) (if (null select) (progn ;(format *sel-log-file* "~a ~a ~a ~a~%" *clock* num-spec origs extincts) (format *rand-log-file* "~a ~a ~a ~a~%" *clock* num-spec origs extincts)) (if (eq select 'selection) (format *sel-log-file* "~a ~a ~a ~a~%" *clock* num-spec origs extincts) (format *rand-log-file* "~a ~a ~a ~a~%" *clock* num-spec origs extincts)))) ;;; This can be left for a later time. ;(defun record-event (type node &optional (mut-locus -1)) ; (format t "~a: id: ~a leaf: ~a ~a~%" *clock* (snode-id node) ; (snode-leaf-id node) type) ; (when (eq 'speciation type) ; (format t " id: ~a leaf-id: ~a~%" (snode-id (snode-left node)) ; (snode-leaf-id (snode-left node))) ; (format t " id: ~a leaf-id: ~a~%" (snode-id (snode-right node)) ; (snode-leaf-id (snode-right node))))) (defun record-event (type node &optional (mut-locus -1))) ; (format t "~a ~a ~a~%" *clock* (snode-id node) type) ; (format t "~a ~a ~a ~a~%" *clock* (snode-id node) mut-locus type))) ;;; This produces a string in the NEWICK format representing the tree ;;; rooted at "node" and displaying nodes as the result of applying ;;; "proc" to the node. Nodes that branched in this last time step ;;; are considered to be 0.5 units old. (defun newick (node proc) (let* ((parent (snode-parent node)) (age (snode-age node)) (branch-length (max 0 (- (if (= age 0) (1+ *clock*) age) (if (null parent) 0 (snode-age parent)))))) (cond ((and (null (snode-left node)) (null (snode-right node))) (format () "~a:~a" (funcall proc node) branch-length)) ((null (snode-left node)) (format () "(~a)~a:~a" (newick (snode-right node) proc) (funcall proc node) branch-length)) ((null (snode-right node)) (format () "(~a)~a:~a" (newick (snode-left node) proc) (funcall proc node) branch-length)) (t (format () "(~a,~a)~a:~a" (newick (snode-left node) proc) (newick (snode-right node) proc) (funcall proc node) branch-length))))) (defun no-name (node) "") (defun record-tree (node proc filename) (let ((fullname (concatenate 'string "output/" filename))) (with-open-file (tree-stream fullname :direction :output :if-exists :overwrite :if-does-not-exist :create) (format tree-stream "~a" (newick node proc))))) (defun record-results () (with-open-file (result-stream "output/results.dat" :direction :output :if-exists :append :if-does-not-exist :create) (format result-stream "~a ~a ~,5,,,F ~,5,,,F ~,5,,,F ~,5,,,F ~,5,,,F ~a " *run-number* *max-diversity* (/ *min-death-count* (* 1.0 *max-diversity*)) (/ *death-count* (* 1.0 *max-diversity*)) (/ *speciation* (* 1.0 PROBSCALE)) (/ *extinction* (* 1.0 PROBSCALE)) (/ *mutation* (* 1.0 PROBSCALE)) *max-depth*) (dotimes (i *max-depth*) (let ((before (svref *survey-before* i))) (format result-stream "~a ~,5,,,F ~,5,,,F ~a ~a ~a ~a " before (/ (svref *survey-after-selection* i) (* 1.0 before)) (/ (svref *survey-after-random* i) (* 1.0 before)) (svref *survey-second-epoch-selection* i) (if (svref *selection-turnover* i) 1 0) (svref *survey-second-epoch-random* i) (if (svref *random-turnover* i) 1 0)))) (format result-stream "~%"))) (defun record-phyles (num-phyles phyle-list filename) (with-open-file (phyle-stream (concatenate 'string "output/" filename) :direction :output :if-exists :append :if-does-not-exist :create) (format phyle-stream "~a:~a[~a]~a" *run-number* #\tab num-phyles #\tab) (dolist (phyle phyle-list) (format phyle-stream "~a~a" phyle #\tab)) (format phyle-stream "~%"))) (defun record-match-phyles (num-matched num-phyles phyle-list phyle-indicies forbiddens filename) (with-open-file (phyle-stream (concatenate 'string "output/" filename) :direction :output :if-exists :append :if-does-not-exist :create) (format phyle-stream "~a: [~a] " *run-number* num-matched) (dolist (phyle phyle-list) (let ((index (pop phyle-indicies))) (when (not (svref forbiddens index)) (format phyle-stream "~a~a" phyle #\tab)))) (format phyle-stream "~%"))) (defun count-unclassifieds (node proc) (if (null node) 0 (+ (if (and (a-leaf? node) (< (funcall proc node) 0)) 1 0) (count-unclassifieds (snode-left node) proc) (count-unclassifieds (snode-right node) proc)))) (defun count-match-unclassifieds (node proc forbiddens) (if (null node) 0 (+ (if (and (a-leaf? node) (not (legal-taxon-id (funcall proc node) forbiddens))) 1 0) (count-match-unclassifieds (snode-left node) proc forbiddens) (count-match-unclassifieds (snode-right node) proc forbiddens)))) ;;; The number of taxa and the average taxon size for each classification. ;;; Note that I haven't included the matched distribution cases because they ;;; exactly match the paraphyle case (100 taxa with an average size of 10). (defun record-classification-stats () (let ((tot-nodes (1+ *max-diversity*))) (with-open-file (class-file "output/classification.dat" :direction :output :if-exists :append :if-does-not-exist :create) (format class-file "~a~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~a~a~a~4,3F~%" *run-number* #\tab *next-paraphyle* #\tab (/ tot-nodes *next-paraphyle*) #\tab *next-hard-monophyle* #\tab (if (= 0 *next-hard-monophyle*) 0 (/ (- tot-nodes (count-unclassifieds *root* #'snode-hard-monophyle)) *next-hard-monophyle*)) #\tab *next-soft-monophyle* #\tab (/ (- tot-nodes (count-unclassifieds *root* #'snode-soft-monophyle)) *next-soft-monophyle*) #\tab *next-syst-monophyle* #\tab (/ (- tot-nodes (count-unclassifieds *root* #'snode-syst-monophyle)) *next-syst-monophyle*) #\tab *next-full-monophyle* #\tab (/ tot-nodes *next-full-monophyle*) #\tab *next-random-taxon* #\tab (/ tot-nodes *next-random-taxon*) #\tab *next-paraphyle* #\tab (/ (- tot-nodes (count-match-unclassifieds *root* #'snode-soft-monophyle *soft-forbidden*)) *next-paraphyle*) #\tab *next-paraphyle* #\tab (/ (- tot-nodes (count-match-unclassifieds *root* #'snode-syst-monophyle *syst-soft-forbidden*)) *next-paraphyle*) #\tab *next-match-random-taxon* #\tab (/ tot-nodes *next-paraphyle*) ))))