(in-package "KPML")

;;; File: extra-reports.lisp

;;; The following is a nicer and more complete version of the old 
;;; internal maintanance function WHO-CAN-REALIZE (now in ml-who-can-what.lisp),
;;; which just gives the information in a list form that requires we know
;;; what the list means before it can be interpreted. 

(defun WHO-CAN-AFFECT (microfunctions &optional (stream *standard-output*))
  (loop for m in microfunctions
        do
  (format stream 
          "~2%Usage report for grammatical microfunction: ~@(~A~)" m)
  (loop for (name report-element)
        in `(("Insertions" ,(kpml-who-can-insert m))
             ("Expansions" ,(kpml-who-can-expand m))
             ("Conflations" ,(kpml-who-can-conflate m))
             ("Preselections" ,(kpml-who-can-preselect m))
             ("Orderings" ,(kpml-who-can-order m))
             ("Lexifies" ,(kpml-who-can-lexify m))
             ("Classifications" ,(kpml-who-can-out-classify m))
             ("Inflections" ,(kpml-who-can-inflectify m)))
        when report-element
        do
        (format stream "~%  ~A" name)
        (pprint-function-with-realization report-element))))

(defun PPRINT-FUNCTION-WITH-REALIZATION (uses &optional (stream *standard-output*))
  (let ((*standard-output* stream))
    (loop for (system . realization) in uses
          do 
          (format stream "~%    ")
          (format stream "~S : " system)
          (loop for (f .  r) in realization
                do (format stream "~:(~A~) [" f)
                (loop for rs in r do (nonansi-pprint-single-rs rs)))
          (format stream "]"))))

;;; ----------------------------------------------------------------------
;;; Following shows the microfunctions used in each region...

(defun REPORT-REGIONS-FUNCTION-USAGE 
       (&optional (regions (get-regions))(stream *standard-output*))
  (format stream "~%~0TRegion ~30TNumber ~34T Functions")
  (loop for r in regions
        do (report-region-function-usage r stream)))

(defun REPORT-REGION-FUNCTION-USAGE (r &optional (stream *standard-output*))
  (let ((mfs (get-used-microfunctions (features-of-region r))))
    (multiple-value-bind (l regions)
        (fetch-region-function-usage r)
      (format stream "~%~0T~A ~30T~A ~34T~{~@(~A~) ~}" r l regions))))

(defun FETCH-REGION-FUNCTION-USAGE (r)
  (let ((mfs (get-used-microfunctions (features-of-region r))))
    (values (length mfs) 
            (sort mfs #'(lambda (f1 f2)
                          (and (symbolp f1)
                               (symbolp f2)
                               (string< f1 f2)))))))

(defun REGION-FUNCTION-COUNT (r)
  (length (get-used-microfunctions (features-of-region r))))

(defun REGION-FEATURE-COUNT (r)
  (length (features-of-region r)))


