From 8968093623a2bc7087527fcce6cc7c324148e3af Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Wed, 18 Feb 2009 21:28:48 -0500 Subject: [PATCH] Added dual versions of a few more words to math.dual. --- extra/math/derivatives/derivatives.factor | 23 +++++++++++-- extra/math/dual/dual-docs.factor | 42 +++++++++++++++++++++++ extra/math/dual/dual-tests.factor | 4 ++- extra/math/dual/dual.factor | 26 ++++++++++---- 4 files changed, 85 insertions(+), 10 deletions(-) diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index 8e69cec129..c6a9d1a357 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -1,8 +1,15 @@ ! Copyright (C) 2009 Jason W. Merrill. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions math.derivatives.syntax ; +USING: kernel math math.functions math.derivatives.syntax + math.order math.parser summary accessors make combinators ; IN: math.derivatives +ERROR: undefined-derivative point word ; +M: undefined-derivative summary + [ dup "Derivative of " % word>> name>> % + " is undefined at " % point>> # "." % ] + "" make ; + DERIVATIVE: + [ 2drop ] [ 2drop ] DERIVATIVE: - [ 2drop ] [ 2drop neg ] DERIVATIVE: * [ nip * ] [ drop * ] @@ -12,6 +19,15 @@ DERIVATIVE: / [ nip / ] [ sq / neg * ] DERIVATIVE: ^ [ [ 1 - ^ ] keep * * ] [ [ dup zero? ] 2dip [ 3drop 0 ] [ [ ^ ] keep log * * ] if ] +DERIVATIVE: abs + [ 0 <=> + { + { +lt+ [ neg ] } + { +eq+ [ 0 \ abs undefined-derivative ] } + { +gt+ [ ] } + } case + ] + DERIVATIVE: sqrt [ sqrt 2 * / ] DERIVATIVE: exp [ exp * ] @@ -31,4 +47,7 @@ DERIVATIVE: atan [ sq 1 + / ] DERIVATIVE: asinh [ sq 1 + sqrt / ] DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ] -DERIVATIVE: atanh [ sq neg 1 + / ] \ No newline at end of file +DERIVATIVE: atanh [ sq neg 1 + / ] + +DERIVATIVE: neg [ drop neg ] +DERIVATIVE: recip [ sq recip neg * ] diff --git a/extra/math/dual/dual-docs.factor b/extra/math/dual/dual-docs.factor index de3b0749a5..6c287a8f1e 100644 --- a/extra/math/dual/dual-docs.factor +++ b/extra/math/dual/dual-docs.factor @@ -46,6 +46,48 @@ HELP: d^ } { $description "Raise a dual number to a (possibly dual) power" } ; +HELP: dabs +{ $values + { "x" dual } + { "|x|" dual } +} +{ $description "Absolute value of a dual number." } ; + +HELP: dacosh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic cosine of a dual number." } ; + +HELP: dasinh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic sine of a dual number." } ; + +HELP: datanh +{ $values + { "x" dual } + { "y" dual } +} +{ $description "Inverse hyberbolic tangent of a dual number." } ; + +HELP: dneg +{ $values + { "x" dual } + { "-x" dual } +} +{ $description "Negative of a dual number." } ; + +HELP: drecip +{ $values + { "x" dual } + { "1/x" dual } +} +{ $description "Reciprocal of a dual number." } ; + HELP: define-dual-method { $values { "word" word } diff --git a/extra/math/dual/dual-tests.factor b/extra/math/dual/dual-tests.factor index 2fe751dd63..ea46c46124 100644 --- a/extra/math/dual/dual-tests.factor +++ b/extra/math/dual/dual-tests.factor @@ -11,4 +11,6 @@ IN: math.dual.tests [ 2 1 ] [ 2 3 1 -1 d* unpack-dual ] unit-test [ 1/2 -1/4 ] [ 2 1 1 swap d/ unpack-dual ] unit-test [ 2 ] [ 1 1 2 d^ epsilon-part>> ] unit-test -[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test \ No newline at end of file +[ 2.0 .25 ] [ 4 1 sqrt unpack-dual ] unit-test +[ 2 -1 ] [ -2 1 dabs unpack-dual ] unit-test +[ -2 -1 ] [ 2 1 dneg unpack-dual ] unit-test \ No newline at end of file diff --git a/extra/math/dual/dual.factor b/extra/math/dual/dual.factor index 214db9b678..36d684bc6d 100644 --- a/extra/math/dual/dual.factor +++ b/extra/math/dual/dual.factor @@ -51,9 +51,9 @@ MACRO: chain-rule ( word -- e ) PRIVATE> MACRO: dual-op ( word -- ) - [ '[ _ ordinary-op ] ] - [ input-length '[ _ nkeep ] ] - [ '[ _ chain-rule ] ] + [ '[ _ ordinary-op ] ] + [ input-length '[ _ nkeep ] ] + [ '[ _ chain-rule ] ] tri '[ _ @ @ ] ; @@ -64,17 +64,29 @@ MACRO: dual-op ( word -- ) [ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan } [ define-dual-method ] each ] with-compilation-unit -! Inverse methods { asinh, acosh, atanh } are not generic, so +! Inverse methods { asinh, acosh, atanh } are not generic, so ! there is no way to specialize them for dual numbers. However, ! they are defined in terms of functions that can operate on ! dual numbers and arithmetic methods, so if it becomes ! possible to make arithmetic operators work directly on dual ! numbers, we will get these for free. -! Arithmetic methods are not generic (yet?), so we have to +! Arithmetic words are not generic (yet?), so we have to ! define special versions of them to operate on dual numbers. : d+ ( x y -- x+y ) \ + dual-op ; -: d- ( x y -- x-y ) \ - dual-op ; +: d- ( x y -- x-y ) \ - dual-op ; : d* ( x y -- x*y ) \ * dual-op ; : d/ ( x y -- x/y ) \ / dual-op ; -: d^ ( x y -- x^y ) \ ^ dual-op ; \ No newline at end of file +: d^ ( x y -- x^y ) \ ^ dual-op ; + +: dabs ( x -- |x| ) \ abs dual-op ; + +! The following words are also not generic, but are defined in +! terms of words that can operate on dual numbers and +! arithmetic. If it becomes possible to implement arithmetic on +! dual numbers directly, these functions can be deleted. +: dneg ( x -- -x ) \ neg dual-op ; +: drecip ( x -- 1/x ) \ recip dual-op ; +: dasinh ( x -- y ) \ asinh dual-op ; +: dacosh ( x -- y ) \ acosh dual-op ; +: datanh ( x -- y ) \ atanh dual-op ; \ No newline at end of file