;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Ling443
;;;
;;; Program for lemmatizing nouns using suffix replacement rules.
;;;
;;;   Author:  Philip Resnik
;;;   Date:    September 16, 1998
;;; 
;;; Usage:
;;; 
;;;      (lemmatize-noun noun)
;;; 
;;;   where noun is a word represented as a list of one-character symbols,
;;;   e.g. (c a t s).  
;;; 
;;; Examples:
;;; 
;;;      (lemmatize-noun  '(c a t s))         =>  (c a t)
;;;      (lemmatize-noun  '(g l a s s e s))   =>  (g l a s s)
;;;      (lemmatize-noun  '(b r i l l i g))   =>  (b r i l l i g)
;;; 
;;; Algorithm:
;;; 
;;;   The program uses a set of ten suffix-replacement rules.
;;;   It tries each rule in turn.  If replacing the old suffix
;;;   with the new suffix results in a word that is in the noun
;;;   dictionary, then that word is returned.  If all the rules
;;;   are tried and none results in finding a singular form in
;;;   the dictionary, then the word itself is returned.  Note,
;;;   therefore, that irregular plurals are not handled.
;;; 
;;;   The suffix replacement rules are as follows:
;;; 
;;;      Old      New       
;;;      suffix   suffix       Example
;;;      -------------------------------------
;;;      ss       ss           (g l a s s) -> (g l a s s)
;;;      s        nil          (b u c k s) -> (b u c k)
;;;      ses      s            (g l a s s e s) -> (g l a s s)
;;;      xes      x            (b o x e s) -> (b o x)
;;;      zes      z            (q u i z z e s) -> (q u i z)
;;;      ches     ch           (m a t c h e s) -> (m a t c h)
;;;      shes     sh           (w i s h e s) -> (w i s h)
;;;      ies      y            (b o d i e s) -> (b o d y)
;;;      es       e            (v a s e s) -> (v a s e)
;;;      es       nil          (t o m a t o e s) -> (t o m a t o)
;;; 
;;;
;;; Example:
;;;
;;;   Given input (b o x e s), the algorithm first tries the rule replacing
;;;   suffix ss with ss.  Since the word, represnted as a list, does not end
;;;   with the suffix (s s), this rule fails.  Next the algorithm tries the
;;;   rule replacing s with NIL.  In this case, it finds that the input does
;;;   have (s) as a suffix, so it replaces the suffix (s) with the suffix
;;;   NIL, producing (b o x e).  However, since (b o x e) is not on the
;;;   dictionary list, this rule also fails to produce a lemma, and the
;;;   algorithm continues down the rule list.  The third rule, attempting to
;;;   replace ses with s, fails for the same reason as the first rule.  When
;;;   the fourth rule is applies, the suffix (x e s) is replaced with (x) to
;;;   produce (b o x), and since (b o x) is found on the dictionary list,
;;;   that value is returned by the function.  
;;;   
;;; Global variables:
;;;
;;;   The program uses the global variable +noun-list+, which
;;;   is defined in file noun-list.lisp.  This is the dictionary
;;;   containing known nouns represesented in list form, as above.
;;;
;;;
;;; Turn in:
;;;
;;;    - A hardcopy listing of your code.  Make sure this
;;;      includes a comment identifying you as the author and
;;;      giving the date.  If you did not do this assignment
;;;      completely solo, you need to identify all collaborators
;;;      and a comment with each function must identify a single 
;;;      primary author of that function, to be agreed upon 
;;;      by the collaborating students. 
;;;
;;;    - A hardcopy of "dribble" output showing the
;;;      output when you evaluate (test)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PEDAGOGICAL NOTE:
;;
;;  Because the logic of the assignment is to implement simpler
;;  "building-block" functions first, they are included in this file
;;  in the order you are likely to implement them.  Stylistically it
;;  is often clearer to have the top-level routine first, followed
;;  by the subroutines it calls.
;;
;;  You should start by executing
;;
;;    (load "noun-list.lisp")
;;
;;  which will define global variable +noun-list+.  Then the simplest
;;  strategy would be to implement the functions in the order given.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun onlistp (word dictlist)
  "Returns T if word is on dictionary list, NIL otherwise"
  ;; You get this one for free.  Don't change it.
  (and (member word dictlist :test #'equal) t))


(defun defined-noun (word)
  "Returns the word itself if word is on global list +noun-list+,
   and returns NIL otherwise.  For example,
     (defined-noun '(c a t))    => (c a t)
     (defined-noun '(f b r z))  => NIL
  "
  ;; Replace this comment with the body of the function
)


(defun suffix (sfxlen list)
  "
   Returns the last sfxlen elements of list.  If
   sfxlen is greater than the length of the list,
   returns nil.  E.g.,
     (suffix 2 '(r a c e s)) => (e s)
     (suffix 0 '(r a c e s)) => NIL
     (suffix 3 '(i n))       => NIL

   This function can make use of the 'nthcdr'
   function, which returns the result of calling
   CDR on the list n times.  For example,
     (nthcdr 2 '(a b c d e f)) => (c d e f)
     (nthcdr 4 '(a b c d e f)) => (e f)
     (nthcdr 8 '(a b c d e f)) => NIL
  "
  ;; Replace this comment with the body of the function
)


(defun prefix (pfxlen list)
  "
   Returns the first pfxlen elements of list.  If
   pfxlen is greater than the length of the list,
   returns the entire list. E.g.,
     (prefix 4 '(r a c e s))  => (r a c e)
     (prefix 0 '(r a c e s))  => NIL
     (prefix 3 '(t h e))      => (t h e)
     (prefix 3 '(i n))        => (i n)

   This function can make use of the 'reverse' function,
   which take a list and returns a list of the elements
   in reverse order.  E.g.
     (reverse '(a b c d)) => (d c b a)
  "
  ;; Replace this comment with the body of the function
)


(defun has-suffix (list sfx)
  "Returns true if and only if sfx is a suffix of list, e.g.
     (has-suffix '(r a c e d) '(e d))  =>  T
     (has-suffix '(r a c e d) '(e s))  =>  NIL
     (has-suffix '(a t) '(i n g))      =>  NIL
     (has-suffix '(r a c e d) nil)     =>  T
  "
  ;; Replace this comment with the body of the function
)

  
(defun concat (list1 list2)
  "Concatenates two lists.  E.g.
    (concat '(a b c) '(d e))  => (a b c d e)
    (concat '(a b c) NIL)     => (a b c)
  "
  ;; You get this one for free.  Don't change it.
  (append list1 list2))


(defun replace-suffix (list old-sfx new-sfx)
  "
   Assuming that list has suffix old-sfx, this function
   returns a version of list in which old-sfx has been replaced
   with new-sfx.  If list does NOT have old-sfx as a suffix,
   the function returns NIL.  E.g.,
     (replace-suffix '(r a c e s) '(e s) '(i n g))    => (r a c i n g)
     (replace-suffix '(r a c e s) '(e d) '(i n g))    => NIL
     (replace-suffix '(r a c i n g) '(e d) '(i n g))  => NIL
     (replace-suffix '(r a c i n g) '(i n g) '(e d))  => (r a c e d)
     (replace-suffix '(r a c i n g) '(i n g) nil)     => (r a c)
  "
  ;; Replace this comment with the body of the function
)


(defun lemmatize-noun (noun)
  "
   Returns the singular form of a plural noun if a suffix-replacement
   rule can be applied that produces a noun known to be in the dictionary.
   If no such rule can be applied, e.g. if the noun is an irregular
   plural or the singular form is not in the dictionary, this function
   returns the noun itself.
  "
  ;; Replace this comment with the body of the function
)
    


(defun test ()
  "Test function for this assignment.  Runs lemmatize-noun
   on a bunch of test cases, printing the results one per line."
  ;; Don't change this function
  (mapcar #'print
     (list 
      (lemmatize-noun '(c l a s s))
      (lemmatize-noun '(c a t s))
      (lemmatize-noun '(c l a s s e s))
      (lemmatize-noun '(b o x e s))
      (lemmatize-noun '(b u z z e s))
      (lemmatize-noun '(c a t c h e s))
      (lemmatize-noun '(c a t c h))
      (lemmatize-noun '(a s h e s))
      (lemmatize-noun '(b o d i e s))
      (lemmatize-noun '(b a s e s))
      (lemmatize-noun '(a l b i n o s))
      (lemmatize-noun '(a l b i n o e s))))
  t)