;; 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
    ))