graphing.rkt

#lang sicp

; A collection of functions
; that can be added to your functions
; to have them produce graphviz dot notation
; as they're run. 
;
; ;-------------
; ; Usage inside functions to be graphed
;
; (define (parent-function num)
;
;   (define self (node-with-args "parent-function" (list num) #t))
;   (called-node self)
;   (branching-call) ; to other-function
;   (let ((x (other-function num)))
;     (if (> x 0)
;       (begin
;         (calling-self self)
;         (parent-function x))
;       )
;
;   ))
;
; (define (other-function num)
;     (define self (node-with-args "other-function" (list num) #t))
;     (called-node self)
;     (end-branch)
;     (- num 1))
;
;
; ;---------
; ; usage outside functions to be graphed
; (start-digraph "exampleCode")
; (calling-node "main")
; (parent-function 6)
; (display-independent-lines independent-lines)
; (end-digraph)
;


; produces this graphvis "dot" data
; digraph exampleCode {
; "main"->"n1_parent-function_3"->"n2_other-function_3";
; "n1_parent-function_3"->"n3_parent-function_2"->"n4_other-function_2";
; "n3_parent-function_2"->"n5_parent-function_1"->"n6_other-function_1";
;
; }


; GENERATES this graph

;                           .─────.
;                          ( main  )
;                           `─────'
;                              │
;                              ▼
;                  .───────────────────────.
;                 (  n1_parent-│unction_3   )
;                  `───────────┼───────────'
;              ┌───────────────┴───────────────┐
;              │                               │
;              ▼                               ▼
;  .───────────────────────.       .───────────────────────.
; (   n2_other-function_3   )     (  n3_parent-function_2   )
;  `───────────────────────'       `───────────────────────'
;                                              │
;                              ┌───────────────┴───────────────┐
;                              ▼                               ▼
;                  .───────────────────────.       .───────────────────────.
;                 (   n4_other-function_2   )     (  n5_parent-function_1   )
;                  `───────────────────────'       `───────────────────────'
;                                                              │
;                                                              ▼
;                                                  .───────────────────────.
;                                                 (   n6_other-function_1   )
;                                                  `───────────────────────'





; digraph digraphName {
(define (start-digraph name)
  (display "digraph ")
  (display name)
  (display " {\n"))

; }
(define (end-digraph)
  (display "\n}")
  )

; "node"
(define (display-node node)
  (display "\"")
  (display node)
  (display "\""))

(define in-chain #f)

; [->] "node"
; will only prints the arrow ->
; if in a calling chain
(define (calling-node node)
  (if in-chain
      (display "->"))
  (display-node node)
  (display "->")
  (set! in-chain #t)
  )

; "node"
(define (called-node node)
  (display-node node))

; -> | node ->
; when in a chain to self
; it is assumed that called-node
; will be displayed at the begging of self
(define (calling-self self)
  (if in-chain
      (display "->")
      (begin
        (display-node self)
        (display "->")
        )))

; used when you're making a call to
; another function and will be
; calling something else from this level
; prints a "->"
(define (branching-call)
  (display "->"))

; used when at the end of a branch chain
; prints a semicolon and ends the
; current calling chain.
; result is that the next call
; comes from the parent node
(define (end-branch)
  (set! in-chain #f)
  (display ";\n"))


; creates a node name for graphviz
; Most of the time you'll want to set include-count to #t
; this causes "n<number>_" to be prepended to the node name.
; this causes it to be a unique node AND the number
; helps you to see what order things were called in.
; If you want all calls to the same function
; with the same arguments to go to the same
; node in the graph set include-count to #f

(define (node-with-args node args include-count)
  (define all (append (list node) args))
  (if include-count
      (set! all (append (list (get-next-count)) all)))
  (define (join list string)
    (cond ((> (length list) 1)
           (join
            (cdr list)
            (string-append
             string
             (stringify
              (if (list? (car list))
                 (list->comma-string (car list))
                 (car list)))
             "_")))
          ((= (length list) 1)
           (if (list? (car list))
               (string-append string (list->comma-string list))
               (string-append string
                              (stringify (car list)))))
          (else string)))
  (join all ""))



(define node-counter 0)
(define independent-lines '())


(define (get-next-count)
  (set! node-counter (+ node-counter 1))
  (string-append "n" (number->string node-counter)))






; dashed-connection used to display connections between things
; within a function.
(define (dashed-connection node-a node-b label)
  (set! independent-lines
        (append independent-lines
                (list
                 (string-append
                  "\""
                  node-a
                  "\"->\""
                  node-b
                  " [style=dotted"
                  (if (string? label)
                      (string-append
                       ",label=\""
                       label
                       "\"")
                      "")
                  "];\n")))))

(define (display-independent-lines indie-lines)
  (if (list? indie-lines)
      (if (> (length indie-lines) 0)
          (begin
            (display (car indie-lines))
            (display-independent-lines indie-lines)))
      (display indie-lines)))



;(define (extend-chain)
;  (display " -> "))
(define (end-node-chain)
  (display ";\n")
  (set! in-chain #f))

(define (stringify x)
    (cond ((string? x) x)
          ((number? x) (number->string x))))

(define (list->comma-string alist)
  (define (join alist string)
    (cond ((> (length alist) 1)
           (join
            (cdr alist)
            (string-append
             string
             (car alist)
             ",")))
          ((= (length alist) 1)
           (if (list? (car alist))
               (string-append string (join (car alist) ""))
               (string-append string (car alist))))
          (else string))

    )
  ;(join alist "")
  (if (= (length alist) 0)
      "null"
      (join alist ""))
  )