Repair issue #32

Author: soegaard

racket-cas/core.rkt

@@ -480,21 +480,21 @@
                                          [(v 1) `(+ @i ,v)]
                                          [(v u) `(+ ,(⊗ @i u) ,v)])]
     ; other
-    [(u s) (plus2 s u)]  ; ok since u can not be a number nor @i, we have that s <<= u
-    [(u u) (times2 2 u)]    
+    [(u s)               (plus2 s u)]  ; ok since u can not be a number nor @i, we have that s <<= u
+    [(u u)               (times2 2 u)]    
     [((k⊗ r u) (k⊗ s u)) (times2 (+ r s) u)]
-    [((k⊗ r u) (k⊗ s v)) #:when (<<= v u) (plus2 s2 s1)]
-    [((⊕ u v) (⊕ _ _)) (plus2 u (plus2 v s2))]
-    [((⊕ u v) _) (plus2 u (plus2 v s2))]
-    [(u (⊕ v w)) 
-     (if (<<= u v)
-         (match (plus2 u v)
-           [(cons '+ _) (match w 
-                          [(cons '+ ws) (list* '+ u v ws)]
-                          [_            (list  '+ u v w)])]
-           [u+v     (plus2 u+v w)])
-         (plus2 v (plus2 u w)))]
-    [(_ _) (list '+ s1 s2)]))
+    [((k⊗ r u) (k⊗ s v))
+     #:when (<<= v u)    (plus2 s2 s1)]
+    [((⊕ u v)  (⊕ _ _))  (plus2 u (plus2 v s2))]
+    [((⊕ u v) _)         (plus2 u (plus2 v s2))]
+    [(u (⊕ v w))         (if (<<= u v)
+                             (match (plus2 u v)
+                               [(cons '+ _) (match w 
+                                              [(cons '+ ws) (list* '+ u v ws)]
+                                              [_            (list  '+ u v w)])]
+                               [u+v     (plus2 u+v w)])
+                             (plus2 v (plus2 u w)))]
+    [(_ _)               (list '+ s1 s2)]))
 
 (module+ test
   (displayln "TEST - Plus")
@@ -565,8 +565,11 @@
 (define (times2 s1 s2)
   (when verbose-debugging? (displayln (list 'times2 s1 s2)))
   (math-match* (s1 s2)
-    [(0 u) 0] [(u 0) 0]
-    [(1 u) u] [(u 1) u]
+    [(0 u) 0] 
+    [(u 0) 0]
+    [(1 u) u] 
+    [(u 1) u]
+
     [(r s)    (* r s)]
 
     [(@i @i)  -1]
@@ -587,9 +590,10 @@
     [((Expt u v) u) #:when (not (integer? u)) (Expt u (⊕ 1 v))]
     [((Expt u v) (Expt u w)) (Expt u (⊕ v w))]
     [(x y) (if (symbol<<? x y) (list '* x y) (list '* y x))]
+    [(-1 (⊕ u v))       (⊕ (times2 -1 u) (times2 -1 v))] ; Issue #32
     ; all recursive calls must reduce size of s1 wrt <<=
     [((⊗ u v) (⊗ _ __)) (times2 u (times2 v s2))]
-    [((⊗ u v) w) (times2 s2 s1)]
+    [((⊗ u v) w)        (times2 s2 s1)]
     [(u (⊗ v w))
      (if (<<= u v)
          (match (times2 u v)
@@ -626,7 +630,9 @@
   (check-equal? (⊗ x '(cos x)) '(* x (cos x)))
   (check-equal? (⊗ (⊗ x y) (Sqr (⊗ x y))) (⊗ (Expt x 3) (Expt y 3)))
   (check-equal? (⊗ 2 (Expt 2 1/2)) '(* 2 (expt 2 1/2)))
-  (check-equal? (⊗ (Expt 2 1/2) 2) '(* 2 (expt 2 1/2))))
+  (check-equal? (⊗ (Expt 2 1/2) 2) '(* 2 (expt 2 1/2)))
+  (check-equal? (⊗ -1 (⊕ 1 x)) '(+ -1 (* -1 x)))
+  (check-equal? (⊕ 1 (⊕ x -1)) 'x))
 
 
 

racket-cas/math-match.rkt

@@ -21,7 +21,7 @@
 
 ; For completeness, code that uses math-match will often use
 ;   u v   to indicate  normalized                   expressions
-;   a b   to indeicate general (maybe unnormalized) expressions
+;   a b   to indicate general (maybe unnormalized) expressions
 
 
 (require (for-syntax racket/string racket/match racket/syntax)         

racket-cas/new-format.rkt

@@ -4,6 +4,7 @@
 (provide use-minus-in-sums?
          implicit-product?
          implicit-minus-one-as-first-factor?
+         explicit-one-as-first-factor?
          output-root?
          output-root-as-power?
          use-sqrt-for-two-as-root-exponent?
@@ -55,6 +56,10 @@
 ; If #t:   (* -1 x) -> -x
 ; If #f:   (* -1 x) -> -1*x (or -1x if implicit-prodcut? is #t
 
+(define explicit-one-as-first-factor? (make-parameter #f))
+; If #t:   (* 1 x) -> 1*x
+; If #f:   (* 1 x) ->   x (or 1x if implicit-prodcut? is #t)
+
 (define output-root? (make-parameter #f))
 ; If #t:   (expt u 1/n) -> root(u,n)
 ; If #t:   (expt u 1/n) -> u^(1/n)
@@ -595,7 +600,7 @@
 (define (format-product ctx x)
   ; Note: implicit-minus-one-as-first-factor affects the output
   ;   If #t:   (* -1 x) -> -x
-  ;   If #f:   (* -1 x) -> -1*x (or -1x if implicit-prodcut? is #t  
+  ;   If #f:   (* -1 x) -> -1*x (or -1x if implicit-product? is #t  
   (define explicit (case (mode) [(latex) "\\cdot "] [else "*"]))
   (define implicit (if (implicit-product?) "" explicit))
   (define (implicit* u v) ; returns either explicit or implicit
@@ -648,7 +653,9 @@
       [(list '* first-factor)
        (format-factor (list* 'first-factor ctx) first-factor)]
       [(list '* 1 last-factor)
-       (~a (format-factor (list* 'last-factor  ctx) last-factor))]
+       (if (explicit-one-as-first-factor?)
+           (~a 1 implicit (format-factor (list* 'last-factor  ctx) last-factor))
+           (~a            (format-factor (list* 'last-factor  ctx) last-factor)))]
       [(list '* -1 last-factor)
        (cond
          [(implicit-minus-one-as-first-factor?)
@@ -1958,6 +1965,19 @@
       (check-equal? (~ `(expt 2 -2)) "$2^{-2}$")
       (check-equal? (~ '(expt y -4)) "$y^{-4}$"))
     (check-equal? (~ '(expt 2 1)) "$2^1$")
+
+    
+    (parameterize ([explicit-one-as-first-factor? #t]
+                   [implicit-product?             #t])
+      (check-equal? (~ `(* 1 x))             "$1x$")
+      (check-equal? (~ `(sin (* 1 x)))       "$\\sin(1x)$")
+      (check-equal? (~ `(* 1 (sin (* 1 x)))) "$1\\sin(1x)$"))
+    (parameterize ([explicit-one-as-first-factor? #t]
+                   [implicit-product?             #f])
+      (check-equal? (~ `(* 1 x))             "$1\\cdot x$")
+      (check-equal? (~ `(sin (* 1 x)))       "$\\sin(1\\cdot x)$")
+      (check-equal? (~ `(* 1 (sin (* 1 x)))) "$1\\cdot \\sin(1\\cdot x)$"))
+
     ;;; END LATEX
     )
 

racket-cas/normalize.rkt

@@ -78,7 +78,7 @@
     [(app: f us) (match u
                    [(list  '/ u v)    (⊘ (n u) (n v))]
                    [(list  '- u)      (⊖ (n u))]
-                   [(list  '- u v)    (⊖ (n u) (n v))]
+                   [(list  '- u v)    (⊕ (n u) (⊗ -1 (n v)))]
                    [(list  'tan v)    (Tan  (n v))]
                    [(list  'sqr u)    (Sqr  (n u))]
                    [(list  'sqrt u)   (Sqrt (n u))]