;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: analyse-carve-exp1.lsp
;;;;    System: 
;;;;    Author: Praveen Paritosh
;;;;   Created: February 2, 2004 20:00:46
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Sunday, February 8, 2004 at 22:46:54 by paritosh
;;;; ---------------------------------------------------------------------------

(in-package :common-lisp-user)

;; Analyse CARVE-EXP1 data

;; Consistency checks

(defparameter *num-countries* 54)
(defparameter *num-participants* 19)

(defun valid-label? (label)
  (member label '(s m l)))

(defun valid-groupings? (groupings participants)
  (if (eql (length participants)
           (length groupings))
    (dolist (grouping groupings)
      (if (and (member (car grouping) participants :key #'car)
               (eql (length (second grouping)) *num-countries*))
        (dolist (group-label (second grouping))
          (if (not (valid-label? group-label))
            (error "Strange label ~A~%" group-label)))
        (error "Participant not found or number of countries not right~%")))
    (error "Mismatch between number of participants and number of groupings")))

;; For each country, make a count of how many people called it small, 
;; medium and large respectively

(defun count-sml (groupings)
  ;; Make a *num-countries* x 3 array to store number of times 
  ;; it was called S, M and L respectively.
  (let ((sml-counts (make-array (list *num-countries* 3) :initial-element 0)))
    (dolist (grouping groupings)
      (dotimes (i *num-countries*)
        (case (nth i (second grouping)) ;; the nth label corresponding to the nth country
          (s (incf (aref sml-counts i 0)))
          (m (incf (aref sml-counts i 1)))
          (l (incf (aref sml-counts i 2))))))
    (print-2d-array sml-counts)
    sml-counts))

(defun compute-percents (sml-counts)
  (let* ((dims (array-dimensions sml-counts))
         (numrows (car dims))
         (numcols (cadr dims))
         (sml-percents (make-array (list numrows (* 3 numcols)) :initial-element 0))
         (count-percent-multiplier (/ 100.0 *num-participants*)))
    (dotimes (i numrows)
      ;; Copy the counts
      (setf (aref sml-percents i 0) (aref sml-counts i 0))
      (setf (aref sml-percents i 1) (aref sml-counts i 1))
      (setf (aref sml-percents i 2) (aref sml-counts i 2))
      ;; Convert counts to percentages
      (setf (aref sml-percents i 3) (* count-percent-multiplier (aref sml-counts i 0)))
      (setf (aref sml-percents i 4) (* count-percent-multiplier (aref sml-counts i 1)))
      (setf (aref sml-percents i 5) (* count-percent-multiplier (aref sml-counts i 2)))
      ;; Sorted percentage values
      (let* ((percentages (list (aref sml-percents i 3)
                                (aref sml-percents i 4)
                                (aref sml-percents i 5)))
             (sorted-percentages (sort percentages #'>)))
        (setf (aref sml-percents i 6) (first sorted-percentages))
        (setf (aref sml-percents i 7) (second sorted-percentages))
        (setf (aref sml-percents i 8) (third sorted-percentages))))  
    (print-2d-array-with-labels sml-percents (mapcar #'car (sort *african-countries* #'< :key #'second))
                                '(small medium large small% medium% large% most-frequent second-most-frequent least-frequent))
    sml-percents))

(defun average (lst)
  (float (/ (reduce #'+ lst) (length lst))))

(defun print-2d-array (arr &optional (stream t))
  (let* ((dims (array-dimensions arr))
         (numrows (car dims))
         (numcols (cadr dims)))
    (dotimes (i numrows)
      (dotimes (j numcols)
        (format stream "~A " (aref arr i j)))
      (format stream "~%"))))

(defun print-2d-array-with-labels (arr rowlabels columnlabels &optional (stream t))
  (let* ((dims (array-dimensions arr))
         (numrows (car dims))
         (numcols (cadr dims)))
    (when (or (not (equal numrows (length rowlabels)))
              (not (equal numcols (length columnlabels))))
      (format t "Row/column label mismatch, Array dim = ~Ax~A, Rowlabels=~A Columnlabels=~A ~%" 
        numrows numcols (length rowlabels) (length columnlabels))
      (return-from print-2d-array-with-labels nil))
    ;; Print column labels
    (format stream " ")
    (dolist (colname columnlabels)
      (format stream " ~A" colname))
    (format stream "~%")
    ;; Print the array
    (dotimes (i numrows)
      (format stream "~A " (nth i rowlabels))
      (dotimes (j numcols)
        (format stream "~A " (aref arr i j)))
      (format stream "~%"))))

;; S: (wfb::area china total_area (* 9596960 sq_km) );; line 23314
(defun total-area-fact? (fact country)
  (and (eql (length fact) 4)
       (eql (car fact) 'wfb::area)
       (eql (second fact) country)
       (eql (third fact) 'data::total_area)       
       (numberp (second (fourth fact)))))

(defun get-area (country &optional (wfb-facts *wfb-facts*))
  (second (fourth (car (member-if  #'(lambda (fact)
                                       (total-area-fact? fact country))
                                  wfb-facts)))))

(defun get-all-areas (&optional (countries *african-countries*))
   (mapcar #'(lambda (country-pair)
                          (cons (car country-pair)
                                (get-area (car country-pair)))) countries))
  
(defparameter *african-countries-areas* 
  ;; computed using get-all-areas above
  '((algeria . 2381740) (angola . 1246700) (benin . 112620) (botswana . 600370) (burkina . 274200)
    (burundi . 27830) (cameroon . 475440) (cape_verde . 4030) (central_african_republic . 622980)
    (chad . 1284000.0) (comoros . 2170) (congo . 342000) (|Cote d'Ivoire| . 322460) (djibouti . 22000)
    (egypt . 1001450) (equatorial_guinea . 28050) (eritrea . 121320) (ethiopia . 1127127) (gabon . 267670)
    (the_gambia . 11300) (ghana . 238540) (guinea . 245860) (guinea-bissau . 36120) (kenya . 582650)
    (lesotho . 30350) (liberia . 111370) (libya . 1759540) (madagascar . 587040) (malawi . 118480)
    (mali . 1240000.0) (mauritania . 1030700) (mauritius . 1860) (morocco . 446550) (mozambique . 801590)
    (namibia . 825418) (niger . 1267000.0) (nigeria . 923770) (rwanda . 26340) (sao_tome_and_principe . 960)
    (senegal . 196190) (seychelles . 455) (sierra_leone . 71740) (somalia . 637660) (south_africa . 1219912)
    (sudan . 2505810) (swaziland . 17360) (tanzania . 945090) (togo . 56790) (tunisa) (uganda . 236040)
    (western_sahara . 266000) (zaire . 2345410) (zambia . 752610) (zimbabwe . 390580)))

(defparameter *african-countries* 
  '((algeria 2) 
    (angola 39)
    (benin 23)
    (botswana 44)
    (burkina 21)
    (burundi 38)
    (cameroon 25) 
    (cape_verde 12)
    (central_african_republic 27)
    (chad 8)
    (comoros 52)
    (congo 29)
    (|Cote d'Ivoire| 19 )
    (djibouti 33)
    (egypt 5)              
    (equatorial_guinea 51)    
    (eritrea 6) 
    (ethiopia 32)
    (gabon 28)
    (the_gambia 14) 
    (ghana 20)
    (guinea 16)
    (guinea-bissau 15)
    (kenya 35)
    (lesotho 47)
    (liberia 18)
    (libya 4)
    (madagascar 49)
    (malawi 41)
    (mali 10) 
    (mauritania 11)
    (mauritius 53)
    (morocco 1)
    (mozambique 42) 
    (namibia 45)
    (niger 9) 
    (nigeria 24)
    (rwanda 37)
    (sao_tome_and_principe 26)
    (senegal 13)
    (seychelles 50)
    (sierra_leone 17)
    (somalia 34)
    (south_africa 46) 
    (sudan 7) 
    (swaziland 48)
    (tanzania 36) 
    (togo 22)
    (tunisia 3)
    (uganda 31)
    (western_sahara 54)
    (zaire 30) ;; Also known as Democratic Republic of Congo
    (zambia 40)
    (zimbabwe 43)))
  
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code