Unparse now handles Equal. -1*x prints as -x. Solve works for a*x+b=0.
This commit is contained in:
parent
0e3e671795
commit
1c86406c9c
|
@ -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)
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -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))
|
||||||
(define unwrapped
|
(cond
|
||||||
(string-append* (add-between (map unparse-factor ops) "*")))
|
[(empty? ops) "1"]
|
||||||
(wrap-if (and level-below-times? (>= (length ops) 2))
|
[(eqv? (first ops) -1)
|
||||||
unwrapped)]
|
(string-append "-" (unparse-product (cons 'Times (rest ops))))]
|
||||||
|
[else
|
||||||
|
(define unwrapped
|
||||||
|
(string-append* (add-between (map unparse-factor ops) "*")))
|
||||||
|
(wrap-if (and level-below-times? (>= (length ops) 2))
|
||||||
|
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)
|
||||||
; Note: Set expressions are compound expressions.
|
(case (kind form)
|
||||||
(format "~a(~a)" (operator form)
|
[(Equal)
|
||||||
(string-append* (add-between (map/first? #t unparse (operands form)) ",")))]
|
(define-values (t r) (equation->sides form))
|
||||||
|
(format "~a=~a" (unparse t) (unparse r))]
|
||||||
|
[else
|
||||||
|
; Note: Set expressions are compound expressions.
|
||||||
|
(format "~a(~a)" (operator 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")
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user