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.
|
||||
! 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 * ]
|
||||
|
@ -32,3 +48,6 @@ DERIVATIVE: atan [ sq 1 + / ]
|
|||
DERIVATIVE: asinh [ sq 1 + sqrt / ]
|
||||
DERIVATIVE: acosh [ [ 1 + sqrt ] [ 1 - sqrt ] bi * / ]
|
||||
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" } ;
|
||||
|
||||
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 }
|
||||
|
|
|
@ -12,3 +12,5 @@ IN: math.dual.tests
|
|||
[ 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.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
|
|
@ -71,10 +71,22 @@ MACRO: dual-op ( word -- )
|
|||
! 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 ;
|
||||
|
||||
: 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