; 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