; 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