Commit cdfc237b authored by Ioanna M. Dimitriou H.'s avatar Ioanna M. Dimitriou H. 💬

This fixes issue #1 and changes the syntax of the graph* functions in a backwards compatible way.

The changes in detail:

- adds nickname :jeffrey to package :jeffrey.main
- moved assertions from main.lisp to a test in test.lisp
- in all graphing functions, STYLE is now an optional argument, which defaults to "numbers".
- exports jeffrey:random-graph, jeffrey:graph-ancestors, jeffrey:graph-descendants
- to celebrate jeffrey's first issues, I added a *brand new* (jeffrey:graph-interval top-form bottom-form filename &optional (style "numbers") ending)
- jeffrey now *also* understands which output format to use from the filename given (e.g. "filename.svg" will produce an svg file, even when the optional ending "svg" is not given).
- fixed documentation of the package jeffrey.main and in the README.md
- cleaned up some whitespace and fixed indentation here and there

Try it:

- (jeffrey:graph '(1 2 3 4 5 6) "forms-1-to-6.svg")
- (jeffrey:graph-descendants '(94) "descendants-of-94")
- (jeffrey:graph-ancestors '(399 256) "ancestors-of-399-or-256.pdf")
- (jeffrey:graph-interval 9 64 "interval-9-to-64.jpg")
- (jeffrey:random-graph 6 "random-6.png")

Still only works for "number" labels, work on "fancy" labels has started.
parent 75e15c8d
fancy-labels/
diagrams/
*~
\ No newline at end of file
This diff is collapsed.
(in-package :jeffrey.draw)
#|
example of expected use of exported function:
(draw '(2 3 65 43 22 102) "diagram-name")
This should draw the diagram between the nodes with names in the
above list, and save the .dot and .pdf files to
~/quicklisp/local-projects/jeffrey/diagrams/diagram-name.dot and
example of expected use of exported function:
(draw '(2 3 65 43 22 102) "diagram-name.png")
This should draw the diagram between the nodes with names in the
above list, and save the .dot and .png files to
~/quicklisp/local-projects/jeffrey/diagrams/diagram-name.dot and
...pdf respectively.
|#
......@@ -14,55 +14,63 @@ above list, and save the .dot and .pdf files to
*local-directory*
"diagrams/"
input-filename
"."
postfix-ending))
(defun print-dot-head ()
"Writes the standard header of a diagram to the {*standard-output*}."
(format *standard-output*
(format *standard-output*
"digraph diagram { ~%
ratio=0.5;~%
node [shape=ellipse,width=0.5,height=1];~%" ))
(defun print-fancy-label (name)
"Takes the node `name` from the user input and returns a string
that makes Graphviz-dot use the pdf file in the folder
`\"form-name-pics\"`, that contains this form's LaTeX formatted
statement."
(format *standard-output*
"~a [image=\"~afancy-labels/~a.png\", label=\" \"];~%"
name *local-directory* name))
"Takes the node NAME from the user input and returns a string
that makes Graphviz-dot use the png file in the folder `fancy-labels`,
which contains this form's LaTeX formatted statement. Requires
(jeffrey.labelmaker::make-fancy-labels), which currently has issues
with `imagemagick`'s `convert`."
(let ((fancy-label-filename (format nil
"~afancy-labels/~a.png"
*local-directory* name)))
(if (probe-file fancy-label-filename)
(format *standard-output*
"~a [image=\"~a\", label=\" \"];~%"
name fancy-label-filename)
(error "~&Fancy labels seem not set up, or not set up properly.
Please evaluate (jeffrey.labelmaker::make-fancy-labels) and retry."))))
(defun print-node-label (name node style)
"Writes the labels for the nodes in the style `style`, depending on
the user input. The user as two choices for a style:
the user input. The user as two choices for a style:
* `\"fancy\"` creates diagrams with the full LaTeX statements of the
forms, which are stored as pictures in png format, in the folder
`diagrams/form-name-pics`. This is the default.
* `\"numbers\"` creates plain diagrams with only 'HR `name`' style
* `\"fancy\"` creates diagrams with the full LaTeX statements of the
forms, which are stored as pictures in png format, in the folder
`diagrams/form-name-pics`. This is the default.
* `\"numbers\"` creates plain diagrams with only 'HR `name`' style
nodes."
(if(equal style "fancy")
(print-fancy-label name)
(unless (equal style "numbers")
(error "Wrong style given in print-dot-file: ~a .~%"
(error "Wrong style given in print-dot-file: ~a .~%"
style))))
(defun print-bold-arrow (name-i name-j)
"Prints a boldfaced arrow in dot-syntax from `name-i` to `name-j`
"Prints a boldfaced arrow in dot-syntax from `name-i` to `name-j`
to the `*standard-output*`."
(format *standard-output*
(format *standard-output*
"~a -> ~a [style=bold];~%"
name-i
name-i
name-j))
(defun print-gray-arrow (name-i name-j)
(format *standard-output*
(format *standard-output*
"~a -> ~a [color=dimgray];~%"
name-i
name-j))
(defun print-arrows-from (name node input-names)
"The loop inside the loop of `draw-dot-content.`"
"The loop inside the loop of `draw-dot-content.`"
(loop for name% in input-names
for node% = (call name%)
when (not (equal name name%))
......@@ -80,33 +88,47 @@ to the `*standard-output*`."
do (print-node-label name node style)
(print-arrows-from name node input-names)))
;; IO
(defun create-dot-file (dot-file input-names style)
"DOT-FILE should be a complete pathname, with (the default) parent directory."
(ensure-directories-exist dot-file :verbose t)
(with-open-file (*standard-output* dot-file
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(print-dot-head)
(print-dot-content input-names style)
(format *standard-output* "~%}")))
(defun run-tred-dot (dot-file result-file ending)
"Runs Graphviz tred on `dot-file` and feeds the output to
Graphviz dot. Outputs `result-file`, which contains the diagram."
(let ((command-string (concatenate 'string
"/usr/bin/tred "
dot-file
" | dot -T"
ending
" -o "
result-file)))
(run "/bin/sh" (list "-c" command-string)
:output t)))
(defun draw (input-names diagram-filename style &optional (ending "png"))
"Runs Graphviz tred on `dot-file` and feeds the output to Graphviz dot.
Outputs `result-file`, which contains the diagram. Requires the system
package Graphviz."
(let ((command-string (concatenate 'string
"/usr/bin/tred "
(namestring dot-file)
" | dot -T"
ending
" -o "
(namestring result-file))))
(if (probe-file (pathname "/usr/bin/tred"))
(run "/bin/sh"
(list "-c" command-string)
:output t)
(error "Graphviz is not installed. Please install and retry."))))
(defun draw (input-names filename style ending)
"`style` should be either the string \"fancy\" or \"numbers\".
`format` can be anything supported by dot, e.g., pdf, png, svg, ps.
The default format is pdf."
(let ((dot-file (make-filename ".dot" diagram-filename))
(result-file (make-filename (concatenate 'string "." ending) diagram-filename)))
(with-open-file (*standard-output* dot-file
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(print-dot-head)
(print-dot-content input-names style)
(format *standard-output* "~%}"))
(run-tred-dot dot-file result-file ending)
(format nil
"Files ~a and ~a in diagrams/ should be created successfully."
dot-file result-file)))
If the DIAGRAM-FILENAME doesn't end in one of those formats, then png will be used."
(let ((dot-file (pathname (make-filename "dot" filename)))
(result-file (pathname
(make-filename ending filename))))
(handler-case
(progn (create-dot-file dot-file input-names style)
(run-tred-dot dot-file result-file ending))
(:no-error (message value)
(format *standard-output*
"~&Files ~a and ~a in diagrams/ should be created successfully.~%"
dot-file result-file)))))
......@@ -8,38 +8,52 @@
collect key))
(defun name-transformer (key names)
(let ((funct (case key
(:these (lambda (node)
(list node)))
(:descendants #'descendants)
(:ancestors #'ancestors))))
(let ((transformer (case key
(:these (lambda (node)
(list node)))
(:descendants #'descendants)
(:ancestors #'ancestors)
(:interval #'interval)))
;; the transformers require nodes input so we get the nodes
(nodes (loop for name in names collect (gethash name *graph*))))
(remove-duplicates
(append
names
(loop for name in names
append (map 'list
#'node-name
(funcall funct (gethash name *graph*))))))))
(assert (equal '(0 1 2 3 4 5)
(name-transformer :these '(0 1 2 3 4 5))))
(assert (equal '(0 18 64 80 127 300 301 389 390)
(sort (name-transformer :descendants '(80 301 64))
#'<)))
(assert (equal '(1 188 193 255 256 258 261 262)
(sort (name-transformer :ancestors '(255 188))
#'<)))
(mapcar
#'node-name ; the transformers return nodes, so we get the names
(append nodes ; add the input nodes to the graph
(if (eq key :interval)
;; interval takes exactly the two given nodes as input
(apply transformer nodes)
;; ancestors or descendants of all the NAMES will be included
(reduce 'append (mapcar transformer nodes))))))))
(defun graph (names-list filename style &optional (ending "png"))
(draw names-list filename style ending))
(defun graph (names-list filename
&optional style ending
&aux (filename% filename))
(let ((pathname (pathname filename)))
(when (null style)
(setq style "numbers"))
(when (null (or ending
(pathname-type pathname)))
(setq ending "png"))
(when (null ending)
(setq ending (pathname-type pathname))
(setq filename% (pathname-name pathname)))
(when (pathname-directory pathname)
(warn "The parent directory of your output file is ignored.
Output files will be placed in ..jeffrey/diagrams/"))
(draw names-list filename% style ending)))
(defun graph-descendants (names-list filename style &optional (ending "png"))
(draw (name-transformer :descendants names-list)
filename style ending))
(defun graph-descendants (names-list filename &optional style ending)
(graph (name-transformer :descendants names-list)
filename style ending))
(defun graph-ancestors (names-list filename style &optional (ending "png"))
(draw (name-transformer :ancestors names-list)
filename style ending))
(defun graph-ancestors (names-list filename &optional style ending)
(graph (name-transformer :ancestors names-list)
filename style ending))
(defun graph-interval (name-1 name-2 filename &optional style ending)
(graph (name-transformer :interval (list name-1 name-2))
filename style ending))
;;; Random graph functions
......@@ -51,7 +65,7 @@
(let ((l (length #1=(set-difference list except-these))))
(nth (random l) #1#)))
(defun random-numbers (n list except-these)
(defun random-numbers (n list except-these)
(loop for i from 1 to n
collecting (random-number list (append except-these numbers))
into numbers
......@@ -68,5 +82,5 @@
(append *bad-forms*
'(0 1)))))
(defun random-graph (amount-of-nodes filename style &optional (ending "png"))
(defun random-graph (amount-of-nodes filename &optional style ending)
(graph (random-HR-numbers amount-of-nodes) filename style ending))
#!/bin/bash
mkdir -p fancy-labels
for i in fancy-labels/*.tex
do
pdflatex -output-directory fancy-labels "$i"
......
......@@ -74,6 +74,7 @@ Apart from the functions described below: {make-node}, {make-edge}, {add-parent}
:setup-jeff-matrix
:descendants
:ancestors
:interval
:implies-p
:implies-not-p)
(:documentation "predicates.lisp enables the program to ask whether or not a node (form) implies another. The function implies-p only answers positive implication questions, and implies-not-p only answers negative implication questions. In particular, (implies-p A B) asks whether A is an ancestor of B and (implies-not-p B A) asks whether there is an ancestor B' of B and a descendant A' of A, such that the node B' has an edge with destination A' and relation NIL. Why is the predicate \"implies-p\" defined like this is clear. For (implies-not-p B A), assume that there is an ancestor B-anc of B and a descendant A-desc of A, such that B-anc does not imply A-desc (the meaning of a NIL-edge from B-anc to A-desc). Then (implies-not-p B A) must be T, i.e., B does not imply A, because otherwise we have the implication chain: B-anc implies B implies A implies A-desc, therefore B-anc implies A-desc, contradiction to the NIL-edge from B-desc to A-desc. "))
......@@ -108,6 +109,7 @@ Apart from the functions described below: {make-node}, {make-edge}, {add-parent}
(defpackage jeffrey.main
(:nicknames :jeffrey)
(:use :common-lisp
:jeffrey.graph
:jeffrey.read
......@@ -115,16 +117,41 @@ Apart from the functions described below: {make-node}, {make-edge}, {add-parent}
:jeffrey.draw)
(:export :name-transformer
:graph
:graph-ancestors
:graph-descendants
:graph-interval
:random-graph
:random-HR-numbers
:*local-directory*
:*names*
:*bad-forms*)
(:documentation "Install this package using quicklisp (installation instructions for quicklisp can be found in https:////www.quicklisp.org//beta//#installation) and git (https:////git-scm.com//book//en//v2//Getting-Started-Installing-Git) as follows:
(:documentation "Install this system and load it using [quicklisp](https:////www.quicklisp.org//beta//#installation) and [git](https:////git-scm.com//book//en//v2//Getting-Started-Installing-Git) as follows:
* Create a folder called `jeffrey` in `quicklisp//local-projects//`,
* Navigate to this folder in a terminal and type `git init` and `git clone git@github.com:ioannad//jeffrey.git`. Alternatively otherwise download the contents of this repository to this folder.
- Install the system dependency Graphviz, for example with aptitude (Debian, Ubuntu, et.al.) using `sudo apt install graphviz`.
- In a terminal, navigate to a directory that ASDF or quicklisp can find (e.g. `quicklisp/local-projects/`) and `git clone https://gitlab.common-lisp.net/idimitriou/jeffrey.git`. Alternatively otherwise download the contents of this repository to such a directory.
- In a Common Lisp REPL, evaluate `(ql:quickload \"jeffrey\")` and `(in-package :jeffrey)`.
To produce a diagram, open a Common Lisp REPL (I have tested it only with SBCL and Clozure CL so far. Please let me know if you test it with other implementations). Then type in `(ql:quickload \"jeffrey\")` and then type in `(in-package :jeffrey.main)`. Now, to draw the diagram between the forms with Howard-Rubin numbers (HR) a b c d ... use the command `(main \"a b c d ...\")`."))
**To draw the diagram between forms** with Howard-Rubin numbers (HR) `a b c d ...` in the file `\"filename.png\"`, evaluate
```
(graph a b c d ... \"filename.png\")
```
The png format is the default so this is equivalent to `(graph a b c d ... \"filename\"). Other supported formats are: `.svg`, `.ps`, `.jpg`. See ` $ man dot`
To draw the diagram of a pseudo-random set of forms, of size N, evaluate `(random-graph n \"filename.png\")`.
Other variations: `(graph-ancestors number \"filename.png\")`, `(graph-descendants number \"filename.png\")`, but be aware that such diagrams might be quite large.
**NEW** `(graph-interval 261 260 \"interval-261-to-260\")` draws all the consequences of form 261 which imply form 260.
All the above graphing functions take an optional extra parameter `STYLE`, where STYLE can be:
- either the string \"numbers\" (the default), using the form numbers as labels in the graph image,
- or the string \"fancy\" which uses LaTeX formatted labels with the full statements of the forms.
To enable this style, execute `./make-fancy-labels`. Requires `pdflatex`, the latex package `standalone`, and `imagemagick`.
Currently there are some issues with imagemagick's `convert` from PDF files, so wait for the next update to use fancy labels.
I have tested `:jeffrey` only with SBCL and CCL (Clozure CL) so far. Please let me know if you test it with other implementations."))
(defpackage jeffrey.parse-web-input
(:use :cl :hunchentoot :split-sequence
......
......@@ -69,6 +69,9 @@ as 'row implies column?'.")
(node-children node)
(map 'list #'descendants (node-children node))))))
(defun interval (X Y)
(intersection (descendants X) (ancestors Y)))
(defun nil-edge-p (Y X) ;; => NIL or nonempty list
"Returns T if there is an edge in (node-edges Y) with :destination X
and :relation NIL."
......
(in-package :jeffrey.test)
;; Test functions in :jeffrey.main
(defun test-name-transformer ()
(assert (equal '(0 1 2 3 4 5)
(jeffrey::name-transformer :these '(0 1 2 3 4 5))))
(assert (equal '(0 18 64 80 127 300 301 389 390)
(sort (jeffrey::name-transformer :descendants '(80 301 64))
#'<)))
(assert (equal '(1 188 193 255 256 258 261 262)
(sort (jeffrey::name-transformer :ancestors '(255 188))
#'<))))
;; Disclaimer: The test data below has no connection with the real data
;; whatsoever.
(defparameter *simple-test-matrix*
......@@ -147,6 +159,8 @@
(defun test-all ()
;; test :jeffrey.main functions
(test-name-transformer)
;; test data
(format t "Setting up test...~%")
(setup-test)
......
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