New extra/math vocabs

db4
Rex Ford 2008-07-22 04:31:11 -04:00
parent 55159701c8
commit 967f2873ab
5 changed files with 48 additions and 2 deletions

View File

@ -0,0 +1,8 @@
! Copyright © 2008 Reginald Keith Ford II
! Tool for computing the derivative of a function at a point
USING: kernel math math.points math.function-tools ;
IN: derivatives
: small-amount ( -- n ) 1.0e-12 ;
: near ( x -- y ) small-amount + ;
: derivative ( x function -- m ) 2dup [ near ] dip [ eval ] 2bi@ slope ;

View File

@ -0,0 +1,8 @@
! Copyright © 2008 Reginald Keith Ford II
! Tools for quickly comparing and evaluating mathematical Factor functions
USING: kernel math arrays ;
IN: math.function-tools
: difference-func ( func func -- func ) [ bi - ] 2curry ;
: eval ( x func -- pt ) dupd call 2array ;
: eval3d ( x y func -- pt ) [ 2dup ] dip call 3array ;

View File

@ -0,0 +1,11 @@
! Copyright © 2008 Reginald Keith Ford II
! Newton's Method of approximating roots
USING: kernel math math.derivatives derivatives ;
IN: newtons-method
<PRIVATE
: newton-step ( x function -- x2 ) dupd [ call ] [ derivative ] 2bi / - ;
: newton-precision ( -- n ) 7 ;
PRIVATE>
: newton-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ;

View File

@ -1,5 +1,4 @@
USING: kernel arrays math.vectors ;
USING: kernel arrays math.vectors sequences math ;
IN: math.points
@ -20,3 +19,9 @@ PRIVATE>
: v+z ( seq z -- seq ) Z v+ ;
: v-z ( seq z -- seq ) Z v- ;
: rise ( pt2 pt1 -- n ) [ second ] bi@ - ;
: run ( pt2 pt1 -- n ) [ first ] bi@ - ;
: slope ( pt pt -- slope ) [ rise ] [ run ] 2bi / ;
: distance ( point point -- float ) v- norm ;
: midpoint ( point point -- point ) v+ 2 v/n ;
: linear-solution ( pt pt -- x ) [ drop first2 ] [ slope ] 2bi / - ;

View File

@ -0,0 +1,14 @@
! Copyright © 2008 Reginald Keith Ford II
! Secant Method of approximating roots
USING: kernel math math.function-tools math.points math.vectors ;
IN: math.secant-method
<PRIVATE
: secant-solution ( x1 x2 function -- solution ) [ eval ] curry bi@ linear-solution ;
: secant-step ( x1 x2 func -- x2 x3 func ) 2dup [ secant-solution ] 2dip swapd ;
: secant-precision ( -- n ) 11 ;
PRIVATE>
: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop v+ 2 v*n ;
! : close-enough? ( a b -- t/f ) - abs tiny-amount < ;
! : secant-method2 ( left right function -- x ) 2over close-enough? [ drop average ] [ secant-step secant-method ] if ;