Commit 0dbfeecb authored by Liam Healy's avatar Liam Healy

Remove unloaded and unused files

Several files in input-output were unloaded, and one was loaded but
unused. These were intended to form the basis of a new capability, and
that capability will now be developed in a separate system.
parent 27d65bc2
;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2015-03-14 10:36:25EDT antik-base.asd>
;; Time-stamp: <2015-12-25 11:33:09EST antik-base.asd>
;; Copyright 2011, 2012, 2013, 2014, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -50,7 +50,6 @@
(:file "matlab")
(:file "org-mode")
(:file "write")
(:file "plist")
(:file "read")))
(:module date-time
:serial t
......
;; Keyword table data structure
;; Jamison Hope 2011-01-18 12:58:19EST data-structure.lisp
;; Time-stamp: <2011-05-23 22:31:56EDT data-structure.lisp>
;; $Id: $
(defun create-table ()
(let ((ht (make-hash-table)))
`#(,ht ,nil))) ; map, list
(defun insert-object (table object keywords)
(if (null keywords)
(push object (cl:aref table 1))
(mapcar (lambda (key)
(let ((rest (remove key keywords :count 1))
(next-table (gethash key (cl:aref table 0))))
(unless next-table
(setf next-table (create-table))
(setf (gethash key (cl:aref table 0)) next-table))
(insert-object next-table object rest)))
keywords)))
(defun flatten-table (table)
(if (null table) '()
(let ((hashed '()))
(maphash (lambda (key value)
(setf hashed (append hashed (flatten-table value))))
(cl:aref table 0))
(delete-duplicates (append hashed (cl:aref table 1))))))
;;; To do: return second value with tags for each object.
(defun find-object (table keywords)
(if (null keywords)
(flatten-table table)
(find-object (gethash (car keywords) (cl:aref table 0))
(cdr keywords))))
(defun remove-object (table object)
(when table
(maphash (lambda (key value)
(remove-object value object))
(cl:aref table 0))
(setf (cl:aref table 1) (remove object (cl:aref table 1)
:test #'equal))))
#|
(setf *table* (create-table))
#(#<HASH-TABLE :TEST EQL :COUNT 0 {1003ECF3E1}> NIL)
* (insert-object *table* "JRH" '(jamie initials))
((("JRH")) (("JRH")))
* (find-object *table* '(jamie initials))
("JRH")
* (find-object *table* '(jamie))
("JRH")
* (find-object *table* '(initials))
("JRH")
* (find-object *table* '(initials liam))
NIL
* (insert-object *table* "LMH" '(liam initials))
((("LMH")) (("LMH")))
* (find-object *table* '(initials liam))
("LMH")
* (find-object *table* '(liam initials))
("LMH")
* (find-object *table* '(liam))
("LMH")
* (find-object *table* '(initials))
("JRH" "LMH")
* (remove-object *table* "JRH")
NIL
* (find-object *table* '(initials))
("LMH")
|#
;; Record the data as it is transformed by functions, for research, pedagogical, or debugging.
;; Liam Healy 2013-02-17 11:02:49HST dataflow.lisp
;; Time-stamp: <2013-02-17 17:54:23HST dataflow.lisp>
;;; Record values or location in the calculation. This is somewhat like reproducible research without the literate programming part.
(in-package :antik)
(export '(tags get-recorded-data clear-recorded-data record-value computation))
;;;;****************************************************************************
;;;; Tags: Keyword symbols added or removed in source code to identify context
;;;;****************************************************************************
(defparameter *context-tags* nil
"A list of tags that indicate the context of the calculation.")
;;; Before compiling, remove :recording from *features* in order to maximize speed
;; #-recording
;; (defmacro tags (add-tags remove-tags &body body)
;; (declare (ignore add-tags remove-tags))
;; `(progn ,@body))
;;;#+recording
(defmacro tags ((add-tags &optional remove-tags) &body body)
"Add or remove tags. This macro is used in source code to identify context for data recording."
`(let ((*context-tags*
(append ,add-tags (set-difference *context-tags* ,remove-tags))))
,@body))
;;; Tag expression similar to feature expressions (file:///usr/share/doc/hyperspec/Body/24_aba.htm).
;;; mapcar `(member ,atom *context-tags*) onto atoms, so that
;;; (and (or (member cat *context-tags*) (member dog *context-tags*)) (member horse *context-tags*))
;;; Maybe eventually check values, e.g. if an iteration count exceeds some value.
;;; (recorded-context-p '(or (and cat dog) horse) '(cat fish)) ;; => NIL
;;; (recorded-context-p '(or (and cat dog) horse) '(dog cat)) ;; => (DOG CAT)
(defun recorded-context-p (tag-expression tags)
"Read tag expression and check that tags match"
(alexandria:once-only ((tags `',tags))
(labels ((in-taglist (sexp)
(etypecase sexp
(list (cons (first sexp) (mapcar #'in-taglist (rest sexp))))
(atom `(member ',sexp ,tags)))))
(in-taglist tag-expression))))
;;;;****************************************************************************
;;;; Data table: global hash table with one entry for each computation sequence.
;;;;****************************************************************************
;;; Each value is saved as (value metadata ...), with metadata a plist. For ease of retrieval, metadata should include a :name, which should be unique within the calculation sequence.
(defvar *current-recorded-data* nil "The data currently being recorded.")
(defvar *recorded-data* (make-hash-table)
"The table of data recorded, indexed by computation identifier.")
(defun save-value (value metadata)
"Save the recorded value and metadata for later playback; return the value."
(push (cons value metadata) *current-recorded-data*)
value)
(defmacro get-recorded-data (identifier)
`(gethash ,identifier *recorded-data*))
(defun clear-recorded-data ()
(clrhash *recorded-data*))
(defvar *last-identifier* nil)
(defun get-value (name &optional (identifier *last-identifier*))
(find name (get-recorded-data identifier) :key (lambda (x) (getf (rest x) :name))))
;;;;****************************************************************************
;;;; Data recording: record value and metadata, define computation sequence
;;;;****************************************************************************
;;; (record-value (/ (+ r1 r2) 2) "The semimajor axis of the transfer ellipse in the Hohmann transfer" :plain "atrans" :tex-subscript "t" :attribute 'semimajor-axis)
(defmacro record-value (value &optional metadata)
"If dynamically surrounded by #'tags and the tag-expression is satisfied, record value and metadata (a plist). This form is used in code to record values. It returns the value."
(alexandria:once-only (value)
`(if (recorded-context-p *tag-expression* *context-tags*)
(save-value ,value ,metadata)
,value)))
;;; Every entrance (thread, recursion) will need to use this macro?
(defmacro computation
((tag-expression &optional (identifier (get-universal-time)) continue-from-identifier)
&body body)
"Compute the form(s) while saving input, intermediate and result data. A tag-expression is specified to indicate which values should be recorded. This form is used at runtime to identify a single set of calculations for recording."
`(let ((*current-recorded-data*
(if ,continue-from-identifier
(copy-list (gethash ,continue-from-identifier *recorded-data*))
(list)))
(*tag-expression* ',tag-expression))
(setf *last-identifier* ,identifier)
(unwind-protect
,@body
(setf (get-recorded-data ,identifier) *current-recorded-data*)
,identifier)))
;; Dataflow with plists
;; Liam Healy 2014-07-16 11:39:11EDT plist.lisp
;; Time-stamp: <2014-07-24 16:15:03EDT plist.lisp>
;; Copyright 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(export '(plist-variables table-plist))
;;; This will need a special rebinding in inca:satfun
(defmacro plist-variables (&rest items)
"Make a plist of all the named variables with keyword keys for the variable names."
(cons 'list
(loop for item in items
appending
(if (symbolp item)
(list (alexandria:make-keyword item) item)
(list (alexandria:make-keyword (first item)) (second item))))))
(defun table-plist (plist)
"Format the plist into an org-mode table."
(alexandria:doplist
(key val plist)
(format t "| ~(~a~) | ~a |~&" key val)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment