-
Notifications
You must be signed in to change notification settings - Fork 4
/
read.lisp
169 lines (145 loc) · 6.12 KB
/
read.lisp
1
2
3
4
5
6
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
(in-package :jeffrey.read)
(defvar *local-directory*
(namestring (asdf:system-source-directory :jeffrey)))
(defvar *bad-forms* '(423 374 383 360)
"These four forms are removed until I figure out how to deal with
them. Form 423 is equivalent to form 374. For 383, FORMSNUM.TEX says:
\"NOTE that 383 and 232 are equivalent. Therefore, 383, and
[383 A]-[383 C] have become [232 H]-[232 K]\". Testing also showed that
360 is not existent (I got a (NIL x) answer between 360 and any other
form name." )
(defvar *forms-file* (concatenate 'string
*local-directory*
"Howard-Rubin-data/FORMSNUM.TEX"))
(defvar *book-file* (concatenate 'string
*local-directory*
"Howard-Rubin-data/book1"))
(defun read-formsnum (forms-file)
"Parses `FORMSNUM.TEX` and returns a list of forms. Each form
starts with a main-form which is possibly followed by equivalent
forms."
(process-forms (with-open-file (formsnum (pathname forms-file))
(with-standard-io-syntax (parse formsnum (=formsnum.tex))))))
(defun read-forms-to-graph (forms-file) ;=> hash table (graph)
"Parses the data in `forms-file` and returns a hash table with the
node information."
(let ((forms (read-formsnum forms-file))
(graph (make-hash-table)))
(loop for form in forms
for main-form = (first form)
for name = (first main-form)
do (assert (integerp name))
unless (member name *bad-forms*)
do (setf (gethash name graph)
(apply #'make-node main-form)))
graph))
(defun read-book1 (book-file) ;=> list of lists (book1-list)
"Parses book1 and returns a list of lists of fields."
(with-open-file (book1 (pathname book-file))
(with-standard-io-syntax (parse book1 (=book1)))))
(defun book1-to-matrix (book1-list) ;=> book1-matrix
"Takes the result of `read-book1`. Returns a matrix version of
book1."
(let* ((n (length book1-list))
(book1-matrix (make-array (list n n) :initial-element NIL)))
(loop for row in book1-list
for i from 0 to (- n 1)
unless (member i *bad-forms*)
do (loop for code in row
for j from 0 to (- n 1)
unless (member j *bad-forms*)
do (setf (aref book1-matrix i j) code))
finally (return book1-matrix))))
(defun add-edge-and-parent (node-a node-b)
"This function adds an edge with destination `node-b` and relation `T`
to `node-a` in `graph`, and it adds `node-a` to the list of parents of `node-b`."
(add-edge node-a (make-edge node-b T))
(add-parent node-b node-a))
(defun add-appropriate-edge (node-a node-b code)
"If `code` = 1 and `node-a` is not `node-b`, this adds a T-edge
from `node-a` to `node-b` and `node-a` to the parents of `node-b`.
If `code` = 3, this adds a NIL-edge from `node-a` to `node-b`.
Else NIL."
(cond ((and (equal code 1)
(not (equal node-a node-b)))
(add-edge-and-parent node-a node-b))
((equal code 3)
(add-edge node-a (make-edge node-b NIL)))
(T NIL)))
(defun matrix-to-graph (matrix graph) ;=> hash-table (graph)
"Takes the result of `book1-to-matrix`, or any similar matrix,
and a hash table (`graph`). Returns a hash table, which is `graph`
with the appropriate `T` and `NIL` edges, which are mentioned in
`matrix`, added. These edges are the ones with codes 1 and 3
respectively."
(loop for name-i being the hash-keys of graph
using (hash-value node-i)
do (loop for name-j being the hash-keys of graph
using (hash-value node-j)
when (member #1=(aref matrix name-i name-j) '(1 3))
do (add-appropriate-edge node-i node-j #1#)))
graph)
(defun graph-to-matrix (graph) ;=> matrix
"Returns a matrix with the NODES information."
(let* ((n (hash-table-size graph))
(matrix (make-array (list n n)
:initial-element NIL)))
(loop for name-1 being the hash-keys of graph
using (hash-value node-1)
unless (member name-1 *bad-forms*)
do (setf (aref matrix name-1 name-1) 1)
(when #1=(node-edges node-1)
(loop for edge in #1#
for name-2 = (node-name (edge-destination edge))
do (if (edge-relation edge)
(setf (aref matrix name-1 name-2) 1)
(setf (aref matrix name-1 name-2) 3)))))
matrix))
(defun add-bottom-node (node graph)
"Unless `node` has edges or it is node 0, add an edge to `node`
with :destination node-0 :relation T, and also add `node` to the
parents of node 0, the bottom node of the graph."
(let ((node-0 (gethash 0 graph)))
(unless (or (some #'edge-relation (node-edges node))
(equal node node-0))
(add-edge-and-parent node node-0))))
(defun add-top-node (node graph)
"Unless `node` is node-1 or it has parents, add node-1 as a parent
and add an edge to node-1 with destination `node` and relation T."
(let ((node-1 (gethash 1 graph)))
(unless (or (node-parents node)
(equal node node-1))
(add-edge-and-parent node-1 node))))
(defun add-top-bottom (graph)
"Takes a graph (a hash table of nodes). Returns `graph` after
having added node 1 as top node and node 0 as bottom node."
(loop for node being the hash-values in graph
do (progn (add-bottom-node node graph)
(add-top-node node graph))
finally (return graph)))
(defun read-all-data ()
"Saves all data from `*forms-file*` and `*book-file*` into
`*graph*`, and returns `book1-matrix` for testing."
(let ((graph (read-forms-to-graph *forms-file*))
(book1-matrix (book1-to-matrix
(read-book1 *book-file*))))
(setf *graph* (add-top-bottom
(matrix-to-graph book1-matrix graph)))
book1-matrix))
#| The following are utility functions, might remove them later. |#
(defun graph-to-implications (graph) ;=> list of implications
"Returns a list of all implications resulting from the graph stored
in `graph`."
(loop for name being the hash-keys of graph
using (hash-value node)
append (loop for edge in (node-edges node)
collect `(,name
,(node-name (edge-destination edge))
,(edge-relation edge)))))
(defun print-graph (graph)
"Prints a slightly readable version of the hash table `graph`."
(maphash (lambda (key value)
(format t "Key= ~S ; Value = ~a~%" key value))
graph))
;; The following will be used a lot for testing:
(defun call (name) (gethash name *graph*))