Tangent
The specificity of Lisp is, maybe, best visible on problems that require processing of data naturally represented as S-expressions. An example of such problem is "Probability that random propositional formula is tautology." In this post, the variation of classical example - symbolic differentiation - is presented: newLISP (and it is very similar in other Lisps) program that computes the tangent of the graph of the function f of single variable, defined as composition of elementary functions (+, -, sin, cos ...) in given point x0. The tangent of the function f in x0 is defined as linear function
y(x) = a·(x - x0) + b,
where a = f '(x0) and b = f(x0). The program consists of:
Few operators from my library are used; function expand// i.e. parallel expand, fexpr println= for convenient printing and floating point arithmetic operators +., -., *. and /., synonymous for built-in add, sub, mul and div. These functions are not essential.
The graph of the complicated function and tangent on the curve suggests that program, generally, works.
(setf f0 (lambda(x)
(+. (sin (*. 12 x))
(cos (*. 32 x))
(tan (*. x 1.4))
(asin x)
(acos x)
(atan x)
(*. x (cos (/. 7 x)))
(sqrt (/. 9 x))
(pow x x)
(*. x (sinh x))
(*. x (cosh x))
(asinh x)
(sin (acosh (+. x 1)))
(atanh x))))
(setf x0 0.4)
(println= (tangent f0 x0))
; (tangent f0 x0)=(lambda (x) (+. (*. -21.491 (-. x 0.4)) 10.252))
Finally, the code:
|
(setf [print.supressed] true [println.supressed] true)
(load "http://www.instprog.com/Instprog.default-library.lsp")
(setf [print.supressed] nil [println.supressed] nil)
(define (tangent f x0)
(letn((variable (first (first f)))
(expression (last f))
(derived-expression (d expression variable))
(a (eval (expand derived-expression
(list (list variable x0)))))
(b (f x0)))
(expand// '(lambda(x)(+. (*. a (-. x x0)) b))
'a 'b 'x0)))
(define (d formula variable)
(simplify
(cond
((= formula variable) 1)
((atom? formula) 0)
((list? formula)
(letn((operator (first formula))
(operands (rest formula))
(lexpand
(lambda(expr)
(letn((flatexpr (flat expr))
(f (if (find 'f flatexpr)(operands 0)))
(df (if (find 'df flatexpr)(d f variable)))
(g (if (find 'g flatexpr)(operands 1)))
(dg (if (find 'dg flatexpr)(d g variable))))
(expand// expr 'f 'df 'g 'dg)))))
(case operator
(+. (cons '+. (map (lambda(op)(d op variable)) operands)))
(-. (cons '-. (map (lambda(op)(d op variable)) operands)))
(*. (case (length operands)
(1 (lexpand 'df))
(2 (lexpand '(+. (*. df g) (*. f dg))))
(true (d (list '*. (first operands)
(cons '*. (rest operands)))
variable))))
(/. (case (length operands)
(1 (d (list '/. 1 (first operands)) variable))
(2 (lexpand '(/. (-. (*. df g) (*. f dg)) (*. g g))))
(true (d (list '/. (first operands)
(cons '*. (rest operands)))
variable))))
(pow (d (lexpand '(exp (*. g (log f)))) variable))
(exp (lexpand '(*. f df)))
(log (if (= (length operands) 1)
(lexpand '(/. df f))
(d (lexpand '(/. (log f) (log g))) variable)))
(sqrt (lexpand '(*. 0.5 df (/. 1 (sqrt f)))))
(sin (lexpand '(*. (cos f) df)))
(cos (lexpand '(*. (-. (sin f)) df)))
(tan (lexpand '(/. df (pow (cos f) 2))))
(asin (lexpand '(/. df (sqrt (-. 1 (*. f f))))))
(acos (lexpand '(-. (/. df (sqrt (-. 1 (*. f f)))))))
(atan (lexpand '(/. df (+. 1 (*. f f)))))
(sinh (lexpand '(*. (cosh f) df)))
(cosh (lexpand '(*. (sinh f) df)))
(tanh (lexpand '(*. (-. 1 (pow (tanh f) 2)) df)))
(asinh (lexpand '(/. df (sqrt (+.(*. f f) 1)))))
(acosh (lexpand '(/. df (sqrt (-. (*. f f) 1)))))
(atanh (lexpand '(/. df (-. 1 (*. f f)))))
))))))
(define (simplify formula)
(cond
((atom? formula) formula)
((list? formula)
(letn((operator (first formula))
(operands (map simplify (rest formula)))
(formula (cons operator operands)))
(cond
; if all operands are constants, then
; simplified formula is evaluated formula
((for-all number? operands)(eval formula))
; (*. x), (+. x) => x
((and (or (= operator '*.) (= operator '+.))
(= (length operands) 1))
(first operands))
; (*. ... 0 ...) => 0
((and (= operator '*.) (find 0 operands)) 0)
; (*. ... 1 ...) => (*. ...)
((and (= operator '*.) (find 1 operands))
(simplify (clean (curry = 1) formula)))
; (+. ... 0 ...) => 0
((and (= operator '+.) (find 0 operands))
(simplify (clean zero? formula)))
; (-. (-. ...)) => ...
((match '(-. (-. ?)) formula)
(last (last formula)))
; (-. minuend ...)
((and (= operator '-.) (> (length operands) 1))
(letn((minuend (first operands))
(subtrahends (rest operands))
(subtrahend (simplify (cons '+. subtrahends))))
(cond ((zero? minuend) (simplify (list '-.
subtrahend)))
((zero? subtrahend) minuend)
((= minuend subtrahend) 0)
(true (list '-. minuend
subtrahend)))))
; (/. (/. ...))
((match '(/. (/. ?)) formula) (last (last formula)))
; (/. dividend ...)
((and (= operator '/.) (> (length operands) 1))
(letn((dividend (first operands))
(divisors (rest operands))
(divisor (simplify (cons '*. divisors))))
(cond ((zero? dividend) 0)
((= divisor 1) dividend)
((= divisor -1) (simplify (list '-. dividend)))
((= dividend divisor) 1)
(true (list '/. dividend divisor)))))
(true formula))))))
|
|
No comments:
Post a Comment