; Use of this file is ungoverned by the Cypherpunks Anti-License.
; Do with it as you will.

; experiments in the upper triangular representation of undirected unigraphs

; also, brute force experiments in the embedding of the same

; for the purpose of this discussion, adjacency relation of any vertex-pair
; is binary {0,1}, directionality is not an issue, nor is magnitude.
; just connectivity


; list of the numbers 0 through n-1

(defun x (n)
 (do*
  ((k n (1- k))
   (r nil (cons k r)))
  ((zerop k) r)))

; give a random permutation of a liszt

(defun random-permutation (liszt)
 (let
  ((val nil)
   pick)
  (do
   ((left liszt (remove pick left :test #'equal)))
   ((null left) val)
   (setf
    pick (nth (random (length left)) left)
    val (cons pick val)))))

; partition the interval [0,1] using the midpoint rule

(defun midpoint-partition (n)
 (let
  ((recip (/ n))
   (val nil))
  (do
   ((q (- (1- (/ recip 2))) (- q recip)))
   ((minusp q) val)
   (setf val (cons q val)))))

; transpose a matrix which is represented as a list of lists

(defun transpose (lol)
 (if (and lol (car lol))
  (cons
   (mapcar #'car lol)
   (transpose (mapcar #'cdr lol)))))


; generate a random embedding of vertices in d dimensional space

(defun random-init-embed (n d)
 (do
  ((left d (1- left))
   (val nil (cons (random-permutation (midpoint-partition n)) val)))
  ((zerop left) (transpose val))))
                                                  
; generate a random list of {1,0} of length n(n-1)/2
; this is essentially the upper triangular of an adjacency matrix
; whose underlying graph is non-directed and is a unigraph (univalent graph)

; no provisions have been made for disconnectedness,
; so more than one graph is a likely outcome

(defun random-adjacency-ut (n)
 (let
  ((utn (/ (* n (1- n)) 2)))
  (do
   ((left utn (1- left))
    (val nil (cons (random 2) val)))
   ((zerop left) val))))

; generate a random graph possessing a random embedding in [0,1]^3

(defun random-graph (n)
 (cons (random-adjacency-ut n) (random-init-embed n 3)))

; correlation function for paired data
; it assumes the data come as a list of pairs (i.e. cons cells)

(defun corr (pairs)
 (let
  (x
   y
   (sx 0)
   (sy 0)
   (sxy 0)
   (sx2 0)
   (sy2 0))
  (do
   ((rest pairs (cdr rest))
    (n 0 (1+ n)))
   ((null rest)
    (/
     (- (* n sxy) (* sx sy))
      (sqrt
       (*
        (- (* n sx2) (* sx sx))
        (- (* n sy2) (* sy sy))))))
   (setf
    x (caar rest)
    y (cdar rest)
    sx (+ sx x)
    sy (+ sy y)
    sxy (+ sxy (* x y))
    sx2 (+ sx2 (* x x))
    sy2 (+ sy2 (* y y))))))

; list C(length(nodelist),2) distinct pairings of nodelist
; this results in a utmatrix not entirely unlike the
; familiar "mileage" (i.e. distance) tables
; on an obsolete technology called printed maps

(defun utpair (nodelist)
 (let
  ((r nil))
  (do
   ((i nodelist (cdr i)))
   ((null (cdr i)) r)
   (do
    ((j (cdr i) (cdr j)))
    ((null j) r)
    (setf r (cons (cons (car i) (car j)) r))))))

; give the distance between two vectors

(defun dist (v1 v2)
 (let
  ((s 0))
  (do
   ((w1 v1 (cdr w1))
    (w2 v2 (cdr w2)))
   ((null w1) (sqrt s))
   (setf s (+ (expt (- (car w1) (car w2)) 2) s)))))

; calculate correlation between adjacency and distance.
; for our purposes, strong negative correlations are most desired.

(defun correlate-graph (graph)
 (corr
  (mapcar
   #'cons
   (car graph)
   (mapcar
    #'(lambda (x) (dist (car x) (cdr x)))
    (utpair (cdr graph))))))

; try to generate an embedding that correlates better.

;(defun improve-graph (graph)
; (let*
;  ((nu (cons (car graph) (random-init-embed (len (car graph)))))
;   (co (correlate-graph graph))
;   (nuco (correlate-graph nu)))
;  (if (< nuco co) nu graph)))

; brute force method for improving graphs

(defun improve-graph (graph)
 (do*
  ((adj (car graph))
   (n (length (cdr graph)))
   (oldcorr (correlate-graph graph))
   (propose (cons adj (random-init-embed n 3)) (cons adj (random-init-embed n 3))))
  ((< (correlate-graph propose) oldcorr) propose)))

; Look up Dan Crippen, perpetuity theorist