Added dual versions of a few more words to math.dual.
parent
6f735fd763
commit
8968093623
|
@ -1,8 +1,15 @@
|
||||||
! Copyright (C) 2009 Jason W. Merrill.
|
! Copyright (C) 2009 Jason W. Merrill.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
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 ]
|
||||||
DERIVATIVE: - [ 2drop ] [ 2drop neg ]
|
DERIVATIVE: - [ 2drop ] [ 2drop neg ]
|
||||||
DERIVATIVE: * [ nip * ] [ drop * ]
|
DERIVATIVE: * [ nip * ] [ drop * ]
|
||||||
|
@ -12,6 +19,15 @@ DERIVATIVE: / [ nip / ] [ sq / neg * ]
|
||||||
DERIVATIVE: ^ [ [ 1 - ^ ] keep * * ]
|
DERIVATIVE: ^ [ [ 1 - ^ ] keep * * ]
|
||||||
[ [ dup zero? ] 2dip [ 3drop 0 ] [ [ ^ ] keep log * * ] if ]
|
[ [ 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: sqrt [ sqrt 2 * / ]
|
||||||
|
|
||||||
DERIVATIVE: exp [ exp * ]
|
DERIVATIVE: exp [ exp * ]
|
||||||
|
@ -31,4 +47,7 @@ DERIVATIVE: atan [ sq 1 + / ]
|
||||||
|
|
||||||
DERIVATIVE: asinh [ sq 1 + sqrt / ]
|
DERIVATIVE: asinh [ sq 1 + sqrt / ]
|
||||||
DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ]
|
DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ]
|
||||||
DERIVATIVE: atanh [ sq neg 1 + / ]
|
DERIVATIVE: atanh [ sq neg 1 + / ]
|
||||||
|
|
||||||
|
DERIVATIVE: neg [ drop neg ]
|
||||||
|
DERIVATIVE: recip [ sq recip neg * ]
|
||||||
|
|
|
@ -46,6 +46,48 @@ HELP: d^
|
||||||
}
|
}
|
||||||
{ $description "Raise a dual number to a (possibly dual) power" } ;
|
{ $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
|
HELP: define-dual-method
|
||||||
{ $values
|
{ $values
|
||||||
{ "word" word }
|
{ "word" word }
|
||||||
|
|
|
@ -11,4 +11,6 @@ IN: math.dual.tests
|
||||||
[ 2 1 ] [ 2 3 <dual> 1 -1 <dual> d* unpack-dual ] unit-test
|
[ 2 1 ] [ 2 3 <dual> 1 -1 <dual> d* unpack-dual ] unit-test
|
||||||
[ 1/2 -1/4 ] [ 2 1 <dual> 1 swap d/ unpack-dual ] unit-test
|
[ 1/2 -1/4 ] [ 2 1 <dual> 1 swap d/ unpack-dual ] unit-test
|
||||||
[ 2 ] [ 1 1 <dual> 2 d^ epsilon-part>> ] unit-test
|
[ 2 ] [ 1 1 <dual> 2 d^ epsilon-part>> ] unit-test
|
||||||
[ 2.0 .25 ] [ 4 1 <dual> sqrt unpack-dual ] unit-test
|
[ 2.0 .25 ] [ 4 1 <dual> sqrt unpack-dual ] unit-test
|
||||||
|
[ 2 -1 ] [ -2 1 <dual> dabs unpack-dual ] unit-test
|
||||||
|
[ -2 -1 ] [ 2 1 <dual> dneg unpack-dual ] unit-test
|
|
@ -51,9 +51,9 @@ MACRO: chain-rule ( word -- e )
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
MACRO: dual-op ( word -- )
|
MACRO: dual-op ( word -- )
|
||||||
[ '[ _ ordinary-op ] ]
|
[ '[ _ ordinary-op ] ]
|
||||||
[ input-length '[ _ nkeep ] ]
|
[ input-length '[ _ nkeep ] ]
|
||||||
[ '[ _ chain-rule ] ]
|
[ '[ _ chain-rule ] ]
|
||||||
tri
|
tri
|
||||||
'[ _ @ @ <dual> ] ;
|
'[ _ @ @ <dual> ] ;
|
||||||
|
|
||||||
|
@ -64,17 +64,29 @@ MACRO: dual-op ( word -- )
|
||||||
[ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan }
|
[ { sqrt exp log sin cos tan sinh cosh tanh acos asin atan }
|
||||||
[ define-dual-method ] each ] with-compilation-unit
|
[ 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,
|
! there is no way to specialize them for dual numbers. However,
|
||||||
! they are defined in terms of functions that can operate on
|
! they are defined in terms of functions that can operate on
|
||||||
! dual numbers and arithmetic methods, so if it becomes
|
! dual numbers and arithmetic methods, so if it becomes
|
||||||
! possible to make arithmetic operators work directly on dual
|
! possible to make arithmetic operators work directly on dual
|
||||||
! numbers, we will get these for free.
|
! 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.
|
! 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 ;
|
||||||
: 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 ;
|
||||||
|
|
||||||
|
: 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 ;
|
Loading…
Reference in New Issue