
;;************************************************************************
;;
;;   PRINTING FUNCTIONS
;;

;;************************************************************************
;;
;;   PRINTING OUT THE CHART
;;
;;  USER INTERFACE FUNCTIONS

(defun show-chart nil
  (format t "~%")
  (mapcar #'(lambda (x) (show-entry-with-name (cadr x)))
          (get-constits-by-name))
  (values))

;;  printing just those constituents that span the input

(defun show-best (&optional s e)
  (let ((start (if s s 0))
        (end (if e e (get-sentence-length))))
  (format t "~%")
  (mapcar #'show-entry-with-name (find-best start end)))
  (values))

;;  Print out the complete structure of the best parses

(defun show-answers (&optional s e)
  (let ((start (if s s 0))
        (end (if e e (get-sentence-length))))
    (Format t "~%~% THE BEST PARSES FOUND~%")
    (mapcar #'(lambda (x)
                (print-tree 0 x nil))
            (find-best start end))
    (values)))

;;  UTILITY FUNCTIONS


(defun show-entry-with-name (entry)
    (Format t "~s:~S from ~S to ~S from rule ~s" (entry-name entry) (entry-constit entry)
            (entry-start entry) (entry-end entry) (entry-rule-id entry))
    (if (is-prob-parse)
      (Format t ", Prob = ~s" (entry-prob entry)))
    (Format t "~%")
)

;; Prints out a constituent, instantiating the variables in its subconstituents 
;;  and prints them with appropriate indentation

(defun print-tree (prefix entry bindings)
  (let* ((subconstitnames (getsubconstitnames 1 (entry-constit entry)))
         (subentries (mapcar #'get-entry-by-name
                              subconstitnames))
         (subconstits (mapcar #'entry-constit subentries))
         (bndgs (merge-lists 
                 (cons bindings (mapcar #'constit-match (entry-rhs entry) subconstits)))))
  (print-blanks prefix)
  (show-entry-with-name entry)
  (mapcar #'(lambda (e) (print-tree (1+ prefix) e bndgs))
          (mapcar #'(lambda (e) (subst-in e bndgs)) subentries))))
         
(defun getsubconstitnames (n constit)
  (let ((sub (get-value constit n)))
    (if sub (cons sub (getsubconstitnames (1+ n) constit))
        nil)))

(defun print-blanks (n)
 (dotimes (i n)
   (format t "  ")))
                          
              

;; RULE-TREE
;;
;; returns list of following form (category rule-id <list of rule-tree return values>)
;;  or (category rule-id) if best-entry-name is a lexical constituent
;;
;; this returns the parse tree for the entry, best-entry-name
;; category is best-entry-name's category. rule-id is the id of rule used
;; to form best-entry-name.  The list of return values correspond to
;; running this function on the subconstituent(s) of this entry.
;;
(defun rule-tree (best-entry-name)
  (let* ((best-entry (get-entry-by-name best-entry-name))
	 (constit (entry-constit best-entry))
	 (category (constit-cat (entry-constit best-entry)))
	 (subconstits (getsubconstitnames 1 constit)))
    (if subconstits
	(list category
	      (entry-rule-id best-entry)
	      (mapcar #'rule-tree subconstits))
      (list category
	    (entry-rule-id best-entry)))))


;; *************************************
;; ************ find-best
;; ***************************************
;;

;;   Note- only constits without gaps are considered.
;;


(defun order-entries (entries)
  (sort entries
	#'<
	:key #'(lambda (x) (entry-start x))))


(defun find-best (start end)
  ;;  this starts from the longest constituent anywhere, and then
  ;;   recursively fills in the constits before and after the best one.
  (let ((constits (order-entries (find-longest-constits start end))))
    (if constits
	(let* (
	       (best-start (entry-start (car constits)))
	       (best-end (entry-end (car constits)))
	       ;;  now grab all ones that go between best-start and best-end
	       (best (remove-if #'(lambda (x)
				    (not (and (= best-start (entry-start x))
					      (= best-end (entry-end x)))))
				constits))
	       (prebest (if (< start best-start)
			    (find-best start best-start)))
	       (postbest (if (< best-end end)
			     (find-best best-end end))))
	  (order-entries (append prebest best postbest))))))


;;   find the longest constituent between start and end (excluding +GAP constits)

(defun find-longest-constits (start end)
  (let ((longest-list nil)
        (longest-length 0))
    (mapcar #'(lambda (entry)
                (when (no-gap (entry-constit entry))
                  (let* ((len (- (entry-end entry) (entry-start entry))))
                    (cond ((> len longest-length)
                           (setq longest-length len)
                           (setq longest-list (list entry)))
                          ((= len longest-length)
                           (setq longest-list (cons entry longest-list)))))))
            (get-constits-between start end))
    (remove-nils longest-list)))

;;   get the constituents between start and end

(defun get-constits-between (start end)
  (if (>= start end) nil
      (append 
       (remove-if #'(lambda (x) (> (entry-end x) end))
                 (aref (get-constits-by-position) start))
       (get-constits-between (+ start 1) end))))

(defun remove-nils (ll)
  (if (null ll) nil
      (if (null (car ll))
        (remove-nils (cdr ll))
        (cons (car ll) (remove-nils (cdr ll))))))

;; given a feature list returns t if GAP feature is absent or '-
(defun no-gap (constit)
  (let ((temp (get-value constit 'GAP)))
    (or (null temp)
        (equal temp '-))))


;;-----------
;; Print given list row by row.
;;
(defun print-list (s lis indent)
  "Prints arbitrary lists, one element per row, indented."
  (dolist (item lis)
    (progn (dotimes (i indent) (princ " " s))
	   (format s "~S~%" item) ))
    (values) )
