;;; -*- Mode: Xbvl;; Syntax: Common-Lisp -*-
; adapté de Paradigms of AI Programming de Peter Norvig

(include "match")

(de rule (pat rep)(list pat rep))
(de rule-pattern (x)(car x))
(de rule-response (x)(cadr x))

(de mkexp (lhs op rhs) (list op lhs rhs))
(de exp-op (x)(car x))
(de exp-lhs (x)(cadr x))
(de exp-rhs (x)(caddr x))

(de exp-p (x) (consp x))
(de exp-args (x) (cdr x))

(defparameter *student-rules* 
  '(((?x ".")                x)
    ((?x "." ?y)          (x y))
    ((if ?x "," then ?y)  (x y))
    ((if ?x then ?y)      (x y))
    ((if ?x "," ?y)       (x y))
    ((?x "," and ?y)      (x y))
    ((find ?x and ?y)     ((= to-find-1 x) (= to-find-2 y)))
    ((find ?x)             (= to-find x))
    ((?x equals ?y)       (= x y))
    ((?x same as ?y)      (= x y))
    ((?x = ?y)            (= x y))
    ((?x is equal to ?y)  (= x y))
    ((?x is ?y)           (= x y))
    ((?x - ?y)            (- x y))
    ((?x minus ?y)        (- x y))
    ((difference between ?x and ?y)  (- y x))
    ((difference ?x and ?y)          (- y x))
    ((?x + ?y)            (+ x y))
    ((?x plus ?y)         (+ x y))
    ((sum ?x and ?y)      (+ x y))
    ((product ?x and ?y)  (* x y))
    ((?x * ?y)            (* x y))
    ((?x times ?y)        (* x y))
    ((?x / ?y)            (/ x y))
    ((?x per ?y)          (/ x y))
    ((?x divided by ?y)   (/ x y))
    ((half ?x)             (/ x 2))
    ((one half ?x)         (/ x 2))
    ((twice ?x)            (* 2 x))
    ((square ?x)           (* x x))
    ((?x % less than ?y)  (* y (/ (- 100 x) 100)))
    ((?x % more than ?y)  (* y (/ (+ 100 x) 100)))
    ((?x % ?y)            (* (/ x 100) y))))

(de student (words)
  ;Solve certain Algebra Word Problems.;
  (solve-equations 
    (create-list-of-equations
      (translate-to-expression (remove-if 'noise-word-p words)))))

(de translate-to-expression (words)
  ;Translate an English phrase into an equation or expression.;
  (or (rule-based-translator
        words *student-rules* 'match
         'rule-pattern  'rule-response
         '(lambda (bindings response)
                      (sublis (mymapcar 'translate-pair (car bindings))
                              response)))
      (make-variable words)))

(de binding-var (binding)
  ;Get the variable part of a single binding.;
  (car binding))

(de binding-val (binding)
  ;Get the value part of a single binding.;
  (cdr binding))

(de translate-pair (pair)
  ;Translate the value part of the pair into an equation or expression.;
  (cons (binding-var pair)
        (translate-to-expression (binding-val pair))))

(de create-list-of-equations (exp)
  ;Separate out equations embedded in nested parens.;
  (cond ((null exp) nil)
        ((atom (car exp)) (list exp))
        (t (append (create-list-of-equations (car exp))
                   (create-list-of-equations (cdr exp))))))

(de noise-word-p (word)
  ;Is this a low-content word which can be safely ignored?;
  (member word '(a an the this number of $)))

(de make-variable (words)
  ;Create a variable name based on the given list of words;
  (car words))

(de solve-equations (equations)
  ;Print the equations and their solution;
  (print-equations "The equations to be solved are:" equations)
  (print-equations "The solution is:" (solve equations nil)))

(de solve (equations known)
  ;Solve a system of equations by constraint propagation.;
  ; Try to solve for one equation, and substitute its value into 
  ; the others. If that doesn't work, return what is known.
  (or (some '(lambda (equation)
                (let ((x (one-unknown equation)))
                  (when x
                    (let ((answer (solve-arithmetic
				   (isolate equation x))))
                      (solve (subst (exp-rhs answer) (exp-lhs answer)
                                    (delete equation equations))
                             (cons answer known))))))
            equations)
      known))

(de isolate (e x)
  ;Isolate the lone x in e on the left hand side of e.;
  ; This assumes there is exactly one x in e,
  ; and that e is an equation.
  (cond ((eq (exp-lhs e) x)
         ; Case I: X = A -> X = n
         e)
        ((in-exp x (exp-rhs e))
         ; Case II: A = f(X) -> f(X) = A
         (isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))
        ((in-exp x (exp-lhs (exp-lhs e)))
         ; Case III: f(X)*A = B -> f(X) = B/A
         (isolate (mkexp (exp-lhs (exp-lhs e)) '=
                         (mkexp (exp-rhs e)
                                (inverse-op (exp-op (exp-lhs e)))
                                (exp-rhs (exp-lhs e)))) x))
        ((commutative-p (exp-op (exp-lhs e)))
         ; Case IV: A*f(X) = B -> f(X) = B/A
         (isolate (mkexp (exp-rhs (exp-lhs e)) '=
                         (mkexp (exp-rhs e)
                                (inverse-op (exp-op (exp-lhs e)))
                                (exp-lhs (exp-lhs e)))) x))
        (t ; Case V: A/f(X) = B -> f(X) = A/B
         (isolate (mkexp (exp-rhs (exp-lhs e)) '=
                         (mkexp (exp-lhs (exp-lhs e))
                                (exp-op (exp-lhs e))
                                (exp-rhs e))) x))))

(de print-equations (header equations)
  ;Print a list of equations.;
  (print header)
       (mapc  (mymapcar 'prefix->infix equations) 'print))

(setq operators-and-inverses
  '((+ -) (- +) (* /) (/ *) (= =)))

(de inverse-op (op)
  (second (assoc op operators-and-inverses)))

(de unknown-p (exp)
  (litatom exp))

(de in-exp (x exp)
  ;True if x appears anywhere in exp;
  (or (eq x exp)
      (and (listp exp)
           (or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))

(de no-unknown (exp)
  ;Returns true if there are no unknowns in exp.;
  (cond ((unknown-p exp) nil)
        ((atom exp) t)
        ((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp)))
        (t nil)))

(de one-unknown (exp)
  ;Returns the single unknown in exp, if there is exactly one.;
  (cond ((unknown-p exp) exp)
        ((atom exp) nil)
        ((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp)))
        ((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp)))
        (t nil)))

(de commutative-p (op)
  ;Is operator commutative?;
  (member op '(+ * =)))

(de solve-arithmetic (equation)
  ;Do the arithmetic for the right hand side.;
  ; This assumes that the right hand side is in the right form.;
  (mkexp (exp-lhs equation) '= (eval (replaceFloat (exp-rhs equation) ))))

(de replaceFloat (l)
  (cond
   ((atom l) l)
   ((null l) nil)
   ((numbp (car l)) (cons (list 'float (car l))(replaceFloat (cdr l))))
   ((atom (car l)) (cons (car l) (replaceFloat (cdr l))))
   (t (cons (replaceFloat (car l))(replaceFloat (cdr l))))))

(de binary-exp-p (x)
  (and (exp-p x) (= (length (exp-args x)) 2)))

(de prefix->infix (exp)
  ;Translate prefix to infix expressions.;
  (if (atom exp) exp
      (mymapcar 'prefix->infix
              (if (binary-exp-p exp)
                  (list (exp-lhs exp) (exp-op exp) (exp-rhs exp))
                  exp))))



(de studen ()
  (print '(student '(if the number of customers Tom gets is 
			twice the square of 20 % of the number of advertisements
			he runs "," and the number of advertisements is 45 "," 
			then what is the number of customers Tom gets "?")))
  (print (student '(if the number of customers Tom gets is twice the square of
		       20 % of the number of advertisements he runs "," and the
		       number of advertisements is 45 "," then what is the number
		       of customers Tom gets "?")))
  (print '(student '(
		     Fran's age divided by Robin's height is one half Kelly's 
		     IQ "." Kelly's IQ minus 80 is Robin's height "." If Robin 
		     is 4 feet tall "," how old is Fran "?")))
  (print (student '(
		    Fran's age divided by Robin's height is one half Kelly's IQ
		    "." Kelly's IQ minus 80 is Robin's height "." if Robin is 4
		    feet tall "," how old is Fran "?")))
  (print '(student '(the daily cost of living for a group is the overhead cost 
		     plus the running cost for each person times the number of
		     people in the group "."  this cost for one group equals
		     "$" 100 "," and the number of people in the group is 
		     40 "." if the overhead cost is 10 times the running 
		     cost "," find the overhead and running cost for each
		     person ".")))
  (print (student '(the daily cost of living for a group is the overhead cost 
		    plus the running cost for each person times the number of
		    people in the group "."  this cost for one group equals
		    "$" 100 "," and the number of people in the group is 40 "."
		    if the overhead cost is 10 times the running cost ","
		    find the overhead and running cost for each person ".")))
)

(de foo ()
  (print '(student '(the price of a radio is 67.70 dollars "." if this price is 15 %
		 less than the marked price "," find the marked price)))
  (print (student '(the price of a radio is 67.70 dollars "." if this price is 15 %
		 less than the marked price "," find the marked price))))

(de foo1 ()
  (print '(student '(the number of soldiers the Russians have is one half of the number
		 of guns they have "." the number of guns they have is 7000 "."
		 what is the number of soldiers they have)))
  (print (student '(the number of soldiers the Russians have is one half of the number
		 of guns they have "." the number of guns they have is 7000 "."
		 what is the number of soldiers they have))))

(de foo2 ()
  (print '(student '(if the number of customers Tom gets is twice the square of 20 %
		the number of advertisements he runs "," and the number of
		advertisements is 45 "," and the profit Tom receives is 10
		times the number of customers he gets "," then what is
		the profit)))
  (priont (student '(if the number of customers Tom gets is twice the square of 20 %
		the number of advertisements he runs "," and the number of
		advertisements is 45 "," and the profit Tom receives is 10
		times the number of customers he gets "," then what is
		the profit))))

(de foo3 ()
  (print '(student '(Tom is twice Mary's age "," and Jane's age is half the 
			 difference between Mary and Tom "." if Marys is 18
			 years old "," how old is Jane "?")))
  (print (student '(Tom is twice Mary's age "," and Jane's age is half the difference
		 between Mary and Tom "." if Marys is 18 years old "," how old
		 is Jane "?"))))
(de foo4 ()
  (print '(student '(what is 4 + 5 * 14 / 7)))
  (print (student '(what is 4 + 5 * 14 / 7)))
  (print '(student '(what is 14 / 7 * 5 + 4)))
  (print (student '(what is 14 / 7 * 5 + 4))))

(de foo5 ()
  (print '(student '(Tom is twice Mary's age "," and Jane's age is half the 
			 difference between Mary and Tom "." if Marys is 18
			 years old "," what is Jane's age "?")))
  (print (student '(Tom is twice Mary's age "," and Jane's age is half the 
			 difference between Mary and Tom "." if Marys is 18
			 years old "," what is Jane's age "?"))))