Unparse now handles Equal. -1*x prints as -x. Solve works for a*x+b=0.

This commit is contained in:
Jens Axel Søgaard 2012-07-04 23:43:16 +02:00
parent 0e3e671795
commit 1c86406c9c
3 changed files with 61 additions and 9 deletions

View File

@ -5,11 +5,13 @@
(require (submod "bracket.rkt" symbolic-application) (require (submod "bracket.rkt" symbolic-application)
(submod "bracket.rkt" bracket) (submod "bracket.rkt" bracket)
(submod "bracket.rkt" solve)
"unparse.rkt") "unparse.rkt")
(provide (for-syntax #%module-begin) (provide (for-syntax #%module-begin)
#%module-begin) #%module-begin)
(provide (all-from-out racket) (provide (all-from-out racket)
Solve
unparse) unparse)
(define-syntax (DeclareVars stx) (define-syntax (DeclareVars stx)

View File

@ -1225,6 +1225,33 @@
(and (free-of u x) (and (free-of u x)
(List 0 u))])))) (List 0 u))]))))
(module solve racket
(require (submod ".." expression)
(submod ".." bracket)
(submod ".." pattern-matching))
(provide Solve)
(define-match-expander List:
(λ (stx)
(syntax-case stx ()
[(_ pat ...) #'(list 'List pat ...)])))
(define-match-expander Equal:
(λ (stx)
(syntax-case stx ()
[(_ pat1 pat2) #'(list 'Equal pat1 pat2)])))
(define (Solve u x)
(match u
[(Equal: u1 u2)
(match (Match-linear-form (Minus u1 u2) x)
[(List: a b)
; ax+b=0 => x= -b/a
(Equal x (Quotient (Minus b) a))])]
[_ #f])))
(module test racket (module test racket
(require (submod ".." symbolic-application) (require (submod ".." symbolic-application)
(submod ".." bracket) (submod ".." bracket)
@ -1393,6 +1420,14 @@
(check-equal? (Match-linear-form (Times 3 x x y) x) #f) (check-equal? (Match-linear-form (Times 3 x x y) x) #f)
(check-equal? (Match-linear-form (Plus 3 (Power x 2) y) x) #f) (check-equal? (Match-linear-form (Plus 3 (Power x 2) y) x) #f)
(check-equal? (Match-linear-form (Plus 3 x y) x) (List 1 (Plus 3 y))) (check-equal? (Match-linear-form (Plus 3 x y) x) (List 1 (Plus 3 y)))
; List:
; Equal:
;;; Solve
(require (submod ".." solve))
(check-equal? (Solve (Equal x 1) x) (Equal x 1))
(check-equal? (Solve (Equal (Times 2 x) 1) x) (Equal x 1/2))
(check-equal? (Solve (Equal (Times a x) b) x) (Equal x (Quotient b a)))
) )

View File

@ -5,7 +5,9 @@
(provide unparse) (provide unparse)
(require (submod "bracket.rkt" expression-core)) (require (submod "bracket.rkt" expression-core)
(submod "bracket.rkt" equation-expression))
(define (map/first? base f xs) (define (map/first? base f xs)
(cond (cond
@ -48,10 +50,15 @@
(case (operator form) (case (operator form)
[(Times) [(Times)
(define ops (operands form)) (define ops (operands form))
(cond
[(empty? ops) "1"]
[(eqv? (first ops) -1)
(string-append "-" (unparse-product (cons 'Times (rest ops))))]
[else
(define unwrapped (define unwrapped
(string-append* (add-between (map unparse-factor ops) "*"))) (string-append* (add-between (map unparse-factor ops) "*")))
(wrap-if (and level-below-times? (>= (length ops) 2)) (wrap-if (and level-below-times? (>= (length ops) 2))
unwrapped)] unwrapped)])]
[else [else
(unparse-factor form first?)])) (unparse-factor form first?)]))
@ -80,10 +87,14 @@
[(times-expression? form) ; This case is for unsimplified expressions [(times-expression? form) ; This case is for unsimplified expressions
(format "(~a)" (unparse-product form #t))] (format "(~a)" (unparse-product form #t))]
[(compound-expression? form) [(compound-expression? form)
(case (kind form)
[(Equal)
(define-values (t r) (equation->sides form))
(format "~a=~a" (unparse t) (unparse r))]
[else
; Note: Set expressions are compound expressions. ; Note: Set expressions are compound expressions.
(format "~a(~a)" (operator form) (format "~a(~a)" (operator form)
(string-append* (add-between (map/first? #t unparse (operands form)) ",")))] (string-append* (add-between (map/first? #t unparse (operands form)) ",")))])]
[else [else
; TODO: pass value unchanged: stuff like #void, #eof, special values etc. ; TODO: pass value unchanged: stuff like #void, #eof, special values etc.
(format "~a" (object-name form)) (format "~a" (object-name form))
@ -102,6 +113,7 @@
(module* test #f (module* test #f
(require rackunit ) (require rackunit )
(require (submod "bracket.rkt" bracket))
(define x 'x) (define x 'x)
(define y 'y) (define y 'y)
(define z 'z) (define z 'z)
@ -125,6 +137,7 @@
(check-equal? (unparse '(Plus -1 x)) "-1+x") (check-equal? (unparse '(Plus -1 x)) "-1+x")
(check-equal? (unparse '(Plus 2/3 x)) "2/3+x") (check-equal? (unparse '(Plus 2/3 x)) "2/3+x")
(check-equal? (unparse '(Plus 2.0 x)) "2.0+x") (check-equal? (unparse '(Plus 2.0 x)) "2.0+x")
(check-equal? (unparse (Minus x)) "-x")
; Products ; Products
(check-equal? (unparse '(Times 2 x)) "2*x") (check-equal? (unparse '(Times 2 x)) "2*x")
(check-equal? (unparse '(Times 2/3 x)) "2/3*x") (check-equal? (unparse '(Times 2/3 x)) "2/3*x")
@ -169,4 +182,6 @@
(check-equal? (unparse '(Set 1)) "Set(1)") (check-equal? (unparse '(Set 1)) "Set(1)")
(check-equal? (unparse '(Set 1 2)) "Set(1,2)") (check-equal? (unparse '(Set 1 2)) "Set(1,2)")
(check-equal? (unparse '(Set 1 2 3)) "Set(1,2,3)") (check-equal? (unparse '(Set 1 2 3)) "Set(1,2,3)")
; Equal
(check-equal? (unparse '(Equal x 2)) "x=2")
) )