;; Gradients
;; ----------
;; A gradient from a source essentially produces a breadth first search tree
;; rooted at the source. Each processor receives a value that represents the
;; shortest path length from the source to that processor. It is possible to
;; implement gradients such that each processor gets the correct path length
;; with extremely high probability (talk to me if you don't buy it) - the real
;; error arises when using the path length as an estimate of DISTANCE from the
;; source. The denser the processors the more likely the path length reresents
;; the straight line distance and even then there is error because of the path
;; length is an integer. Smoothing can correct that to some extent - to understand
;; the effect of processor density and layout on the error see AI Memo 1666
;;
;; This file implements gradients without using messages, to speed up simulations.
;; As explained above, this does not buy you immunity from the real error.
;; The gradient appears all at once after gradient-delay, but you could trivially
;; implement a timing delay proportional to the path length so that the gradient
;; appears with more delay as one moves away from the source.
;;
;; Smoothing::
;; Smoothed gradients (averaged gradient value) are also implemented
;; and a processor receives both the non-smoothed and smoothed
;; gradient value.
;;
;; Multiple Gradients::
;; Deals with multiple gradients. The events from different gradients (i.e. with different
;; names) do not clobber each other. Ideally instead of a single GRADIENT-EVENT
;; each gradient X would have its own event called X.
;;
;; Multiple Sources::
;; This file does not implement any cheat for multiple sources emitting the same gradient.
;; A processor must decide what to do within its hlsim program. It can react to the first
;; gradient value it hears or wait for some time and keep the lowest value heard.
;; This is important when trying to create gradients from multiple sources such as a line
;; of processors. The desired gradient value is the shortest distance to the line. - which
;; translates to the shortest of the shortest paths to every source in the line. Eventually
;; this case will also be included in this file.
;;
;;-----------------------------------------------------------------------------------------
;;
;; How To Use
;;------------
;; The following procedure must be added to the init.scm file (cheat procedures file)
;; (define (create-gradient cont fuel store name)
;; (%create-gradient cont fuel store name))
;; Within the processor's program must include
;; (define gradient-event (make-event))
;; To create a gradient named g1 call
;; (create-gradient 'g1)
;; Processors receive an event called gradient-event, with the value
;; ('g1 integer-gradient-value smoothed-fp-gradient-value)
;;
;;-----------------------------------------------------------------------------------------
(declare (usual-integrations))
(define gradient-delay 1000)
(define resend-gradient-delay 100)
; Create a gradient with the name NAME
(define (%create-gradient cont fuel store name)
(let* ((my-id (store.index store))
(sim (store.simulation store))
(n (simulation.n-processors sim))
; compute gradient values immediately
(gradient-storage (compute-gradient my-id (simulation.neighbours sim)))
)
(pp (list my-id 'creating-gradient name))
; At delivery time, send a gradient event to every processor
; along with the gradient name and value
(define (delivery)
(let ((event-cache (make-cache 'GRADIENT-EVENT)))
(define (deliver-to-proc index)
(let ((pstore (processor.store (vector-ref (simulation.processors sim) index)))
(gradient-value (vector-ref (car gradient-storage) index))
(smoothed-value (vector-ref (cdr gradient-storage) index)))
(define (try-to-deliver)
(let ((event (global-ref pstore event-cache)))
(if (event? event) ; check if processor defined gradient-event
(if (event.signalled? event)
; prevent multiple gradients from clobbering each other
(simulation.enqueue+ sim resend-gradient-delay try-to-deliver)
; (name value smoothed-value)
(event.signal! event (list name gradient-value smoothed-value))
))))
(try-to-deliver)
))
(do ((i 0 (+ i 1))) ((= i n))
(deliver-to-proc i))
)); end delivery
; Queue delivery of the gradient after a delay period
(simulation.enqueue+ sim gradient-delay delivery))
(cont unspecific (fix:- fuel 1) store))
;; Compute shortest paths by Breadth First Search O(V+E)
;; later when edges are weighted may move to Djikstra O(V^2 + E)
;; Also compute smoothed shortest path
(define (compute-gradient src-id neighbour-list)
(let ((t (compute-bfs src-id neighbour-list)))
(cons t (compute-smoothed-gradient t neighbour-list))
))
(define (compute-bfs src-index adjacency-list)
; basic algorithm -
; maintain a list of vertices (start with src node)
; for each vertex in that list, check all nbrs(v)
; if the shortest path for the nbr is unassigned then
; s(nbr) = s(vertex)+1 & add nbr to the list of vertices
; to be explored next time
(let* ((n (vector-length adjacency-list))
(shortest-paths (make-initialized-vector n (lambda (i) i #f))) )
(define (s v) (vector-ref shortest-paths v))
(define (set-s! v l) (vector-set! shortest-paths v l))
(set-s! src-index 0)
(let lp ((check-vertices (list src-index)))
(if (null? check-vertices)
'done
(let ((new '()))
(for-each
(lambda (vertex) ; update the shortest path for its neighbors
(for-each-vector-element ; dumb, the arguments are switched
(vector-ref adjacency-list vertex)
(lambda (nbr)
(if (not (s nbr)) ; unassigned
; s(nbr) = s(v) + 1, add nbr to list
(begin (set-s! nbr (+ (s vertex) 1))
(set! new (cons nbr new)))))
))
check-vertices)
; redo for all newly assigned nodes
(lp new))
)) ; end loop
shortest-paths
))
(define (compute-smoothed-gradient shortest-paths adjacency-list)
(let* ((n (vector-length adjacency-list))
(smoothed (make-initialized-vector n (lambda (i) i #f))) )
(do ((i 0 (+ i 1))) ((= i n))
(let ((adjlist (vector->list (vector-ref adjacency-list i))))
; average neighbor and self shortest paths
(vector-set! smoothed i
(if (not (vector-ref shortest-paths i))
#f ; not connected to the source
(exact->inexact
(/ (+ (vector-ref shortest-paths i)
(reduce + 0 (map (lambda (a) (vector-ref shortest-paths a))
adjlist)))
(+ 1 (length adjlist))))
))
))
smoothed
))