; http://geocities.com/n8chz/utgraph.txt
; 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
; Kitchen tested under
; Gnu Common Lisp
; version 2-2.2000000000000002
; 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 &optional (d 3))
(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
; The #'random-graph function in utgraph.lsp
; generates a random embedded graph in ut
; representation.
; The car of the resulting list is of length n(n-1)/2
; and gives the adjacencies between the n vertices
; The cdr of the result is a list of the d dimensional
; coordinates of the n vertices.
; Each of these is given as a list of d numbers.
(defun random-graph (n &optional (d 3))
(cons (random-adjacency-ut n) (random-init-embed n d)))
; 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
; The order in which the pairings are presented is as follows:
; n-1,n
; n-2,n
; n-2,n-1
; n-3,n
; ...
; 1,n
; ...
; 1,3
; 1,2
(defun utpair (nodelist)
(let
((result nil))
(do
((i nodelist (cdr i)))
((null (cdr i)) result)
(do
((j (cdr i) (cdr j)))
((null j) result)
(setf result (cons (cons (car i) (car j)) result))))))
; give the square of 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)))
(d (length (cadr graph)))
(oldcorr (correlate-graph graph))
(propose (cons adj (random-init-embed n d)) (cons adj (random-init-embed n d))))
((< (correlate-graph propose) oldcorr) propose)))
; Look up Dan Crippen, perpetuity theorist