;; 1/30 - 1/31/04
;; Matt Jadud / Jordan Johnson

(module prefix-infix mzscheme
  (provide prefix->infix
           prefix->infix-xexpr  ;; generates an xexpr using CSS classes
                                ;; "expression", "exponent", and "base"
           generate-expression
           equivalent-exprs?
           )

  (require (lib "plt-match.ss")
           (lib "etc.ss"))              ;; for opt-lambda

  (define operator?
    (lambda (s)
      (member s '(expt + - * /))))

  (define op>
    (lambda (outer-op inner-op)
      (or (eq? outer-op 'expt)
          (and (member inner-op '(+ -))
               (member outer-op '(* /))))))

  (define (precedence> outer-op inner-op)
    (op> outer-op inner-op))

  (define (precedence=? op1 op2)
    (or (and (memq op1 '(+ -))
             (memq op2 '(+ -)))
        (and (memq op1 '(* /))
             (memq op2 '(* /)))))

  ;; sym[+, -, *, /] exp sym[right left] -> boolean
  ;; Returns true if expr is complex and requires wrapping with parentheses if
  ;; it is inside of an expression that uses outer-op as its operator.  (I.e.,
  ;; if exp's operator is of lower precedence than outer-op.  If the
  ;; expression is the right branch, it might need to be parenthesized if
  ;; they're of equal precedence.
  (define (needs-parens? outer-op expr side)
    (match expr
      ((? number? expr)         ;; parens around negative base in expt expr
       (and (negative? expr)
            (eq? outer-op 'expt)))
      (`(,sub-op ,e1 ,e2)
        (or (precedence> outer-op sub-op)
            ;(and (eq? side 'right)
            ;     (and #t ; (memq outer-op '(/ -))
            (precedence=? outer-op sub-op)))
      (else #f)))


  ;; expr expr -> boolean
  ;; Tells whether two expressions are equivalent.  The first one (e1) is
  ;; treated as the one against which the second is being checked; thus it
  ;; will always be treated as a binary expression.  It checks for commutative
  ;; transformation of + and *, too.
  (define (equivalent-exprs? e1 e2)
    (match e1
      ((? number? e1)
       (and (number? e2) (= e1 e2)))
      ((? operator? e1)
       (and (operator? e2) (eq? e1 e2)))
      ((? symbol? e1)                           ;; variable
       (and (symbol? e2) (eq? e1 e2)))
      (`(,e1-op ,e-sub1 ,e-sub2)
        (match e2
          (`(,e2-op ,e2-sub1 ,e2-sub2)
            (and (eq? e1-op e2-op)
                 (case e1-op
                   ((+ *)       ;; commutative ops
                    (or (and (equivalent-exprs? e-sub1 e2-sub1)
                             (equivalent-exprs? e-sub2 e2-sub2))
                        ;; Commute if needed:
                        (and (equivalent-exprs? e-sub1 e2-sub2)
                             (equivalent-exprs? e-sub2 e2-sub1))))
                   (else
                     (and (equivalent-exprs? e-sub1 e2-sub1)
                          (equivalent-exprs? e-sub2 e2-sub2))))))
          ;; Rare case: user entered (sqr x) for (expt x 2)
          (`(sqr ,e2-sub1)
            (and (eq? e1-op 'sqr)
                 (and (number? e-sub2) (= e-sub2 2))
                 (equivalent-exprs? e-sub1 e2-sub1)))
          (else #f)))
      (else
        (error 'equivalent-exprs? "malformed expr: ~a" e1))))

  (define prefix->infix
    (lambda (exp)
      (match exp
        ((? number? exp)
         (format "~a" exp))
        ((? symbol? exp)
         (format "~a" exp))
        ('(expt)
         "^")
        ((? operator? exp)
         (format "~a" exp))
        (`(,op ,exp1 ,exp2)
         (format "~a ~a ~a"
                 (if (needs-parens? op exp1 'left)
                   (format "(~a)" (prefix->infix exp1))
                   (prefix->infix exp1))
                 (prefix->infix op)
                 (if (needs-parens? op exp2 'right)
                   (format "(~a)" (prefix->infix exp2))
                   (prefix->infix exp2)))))))

  ;; fix-parens-xexpr : symbol expr symbol[left or right] -> xexpr
  ;; prefix->infix-xexpr : expr -> xexpr
  ;; Mutually recursive.
  (define (fix-parens-xexpr outer-op expr side)
    (let ((expr-x (prefix->infix-xexpr expr)))
      (if (needs-parens? outer-op expr side)
        `(span ((class "expression"))
           "(" ,expr-x ")")
        expr-x)))

  (define prefix->infix-xexpr
    (lambda (exp)
      (match exp
        ((? number? exp)
         (format "~a" exp))
        ((? symbol? exp)
         (format "~a" exp))
;         ('(expt)
;          "^")
;         ((? operator? exp)
;          (format "~a" exp))
        (`(expt ,exp1 ,exp2)
          `(span ((class "expression"))
              (span ((class "base"))
                ,(fix-parens-xexpr 'expt exp1 'left))
              (sup ((class "exponent"))
                ,(fix-parens-xexpr 'expt exp2 'right))))
        (`(,op ,exp1 ,exp2)
          `(span ((class "expression"))
             ,(fix-parens-xexpr op exp1 'left)
             nbsp
             ,(symbol->string op)
             nbsp
             ,(fix-parens-xexpr op exp2 'right))))))

  ;;;; Generating expressions:

  ;; boolean -> symbol
  (define (random-op using-expt?)
    (let ((ops (if using-expt?  '(expt + - * /) '(+ - * /))))
      (list-ref ops (random (length ops)))))

  (define VARS '(m n x y z w p q r))
  (define VAR-FREQUENCY 3)      ;; 1/VAR-FREQUENCY atomic operands will be vars
  (define NEG-FREQUENCY 3)      ;; likewise for negative numbers
  (define MAX-OPERAND-MAGNITUDE 30)

  ;; bool bool -> symbol or number
  ;; Randomly generates either
  ;;    - a random variable, or
  ;;    - a positive number from 1 to MAX-OPERAND-MAGNITUDE, or
  ;;    - a nonzero integer from (- MAX-OPERAND-MAGNITUDE)
  ;;            to MAX-OPERAND-MAGNITUDE
  (define (random-operand using-vars? using-negatives?)
    (let ((var? (and using-vars? (zero? (random VAR-FREQUENCY)))))
      (if var?
        (list-ref VARS (random (length VARS)))
        (let ((n (add1 (random MAX-OPERAND-MAGNITUDE)))
              (neg? (and using-negatives?
                         (zero? (random NEG-FREQUENCY)))))
          (if neg? (- n) n)))))

  (define generate-expression
    (opt-lambda (n [using-vars? #f] [using-negatives? #f] [using-expt? #f])
      (let loop ((n n))
        (cond
          ((zero? n) (random-operand using-vars? using-negatives?))
          (else
            `(,(random-op using-expt?)
               ,(loop (random n))
               ,(loop (random n))))))))

  )

; (prefix->infix `(* (* (- (- 10 27) (- 19 9)) (- (* 29 14) (+ 12 21)))
;                    (* (- (* 17 25) (- 18 8)) (- (- 24 25) (* 7 6)))))