;; Copyright (c) 2006
;;;   Ben Waldron;
;;; see `LICENSE' for conditions.

(in-package :lkb)

;;; INEFFICIENT. never mind.
;;; return all edge paths between node-x and node-y
(defun get-edge-paths-x2y (node-x node-y &key back-array)
  (unless back-array
    (setf back-array (get-paths-x2y node-x node-y)))
  (if (equalp node-x node-y)
      (list nil)
      (loop
	  with sources = (svref back-array node-y)
	  for source in sources
	  for edge-paths = (get-edge-paths-x2y node-x source
					       :back-array back-array)
	  for edges = (get-tedges-source-target source node-y)
	  append
	    (loop
	        for edge-path in edge-paths
	        append
		  (loop
		      for edge in edges
		      collect (append edge-path (list edge)))))))

;;; return set of edges on paths from node-x to node-y
(defun get-edges-x2y (node-x node-y)
  (loop
      with array = (get-paths-x2y node-x node-y)
      for target from 0 below (length array)
      for sources = (svref array target)
      append
	(loop for source in sources
	    append (get-tedges-source-target source target))))

;;; return token edges spanning source to target
(defun get-tedges-source-target (source target)
  ;; fix_me inefficient
  (intersection
    (get-tedges-source source)
    (get-tedges-target target)))

;;; return token edges outgoing from source node
(defun get-tedges-source (source)
  (loop
      for edge in (aref *tchart* source 1)
      when (token-edge-p edge)
	   collect edge))

;;; return token edges ingoing to target node
(defun get-tedges-target (target)
  (loop
      for edge in (aref *tchart* target 0)
      when (token-edge-p edge)
	   collect edge))

;;; true if exists path of morph edges spanning tchart
(defun medge-spanning-path-p nil
  (svref (get-paths-x2y 0 *tchart-max* 
		       :filter #'morpho-stem-edge-p)
         *tchart-max*))

;;; true if exists path of morph edges in tchart from x to y
(defun medge-path-x2y-p (x y)
  (svref (get-paths-x2y x y
		       :filter #'morpho-stem-edge-p)
	 y))

(defun medge-spanned-p (source target)
  (or
    (medge-path-x2y-p source target)
    ;; [bmw] fix_me: implement graph functions cleanly
    (loop
        for edge in (aref *tchart* target 1) ; out 
        for target2 = (edge-to edge)
        thereis (medge-path-x2y-p source target2))))

;;; add 1-paths from node-z to agenda
(defun update-paths-x2y-agenda (node-z agenda &key (filter #'identity))
  (loop
      for edge in (aref *tchart* node-z 1) ; out 
      for source = (edge-from edge)
      for target = (edge-to edge)
      when (funcall filter edge)
      do (pushnew (cons source target) agenda :test #'equalp))
  agenda)

;;; return array defining paths from node-x to node-y
(defun get-paths-x2y (node-x node-y &key (filter #'identity))
  (let* (;; create array to store paths from x
	 (paths-from-x (make-array (1+ *tchart-max*) :initial-element nil))
	 ;; initialise agenda
	 (agenda nil))
    (unless (= node-x node-y)
      (setf agenda (update-paths-x2y-agenda node-x nil :filter filter))
      ;; process agenda items...
      (loop 
	  with processed = nil
	  while agenda
	  for item = (pop agenda) ; next item
	  for source = (car item)
	  for target = (cdr item)
	  unless (member item processed :test #'equalp)
	  do
	    ;; update array
	    (setf (svref paths-from-x target)
	      (cons source (svref paths-from-x target)))
	    (unless (= target node-y)
	      ;; no loops, so no need to look further
	      (setf agenda
		(update-paths-x2y-agenda target agenda :filter filter)))
	    (push item processed)))
    ;; pick out result
    paths-from-x))