# Paste: dual numbers

Author: | Jason Merrill |

Mode: | factor |

Date: | Fri, 6 Feb 2009 00:16:35 |

Plain Text |

USING: kernel math math.functions math.derivatives accessors words
generalizations sequences generic.parser fry locals compiler.units
continuations quotations combinators macros ;
IN: math.dual
TUPLE: dual ordinary-part epsilon-part ;
C: <dual> dual
M: number ordinary-part>> ;
M: number epsilon-part>> drop 0 ;
: unpack-dual ( dual -- ordinary-part epsilon-part )
[ ordinary-part>> ] [ epsilon-part>> ] bi ;
<PRIVATE
:: chain-rule ( derivative-list n -- x )
{ [ [ epsilon-part>> ] n napply ] [ [ ordinary-part>> ] n napply ] }
n ncleave
derivative-list [ n ncurry ] n nwith map
spread n narray sum ; inline
PRIVATE>
:: [dual-op] ( word -- quot )
word "derivative" word-prop :> derivative-list
derivative-list length :> n
[ [ [ ordinary-part>> ] n napply word execute ] n nkeep
derivative-list n chain-rule
<dual> ] ;
MACRO: dual-op ( word -- ) [dual-op] ;
: define-dual-method ( word -- )
[ \ dual swap create-method-in ] keep [dual-op] define ;
<< { sqrt exp log sin cos tan sinh cosh tanh atan }
[ define-dual-method ] each >>
: 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 ;

Author: | slava |

Mode: | factor |

Date: | Fri, 6 Feb 2009 00:28:47 |

Plain Text |

:: [dual-op] ( word -- quot )
word "derivative" word-prop :> derivative-list
derivative-list length :> n
n word '[ [ ordinary-part>> ] _ napply _ execute ] n
derivative-list n
'[
_ _ nkeep
_ _ chain-rule
<dual>
] ;

## New Annotation