| 
									
										
										
										
											2008-11-07 01:24:32 -05:00
										 |  |  | ! Copyright (c) 2008 Reginald Keith Ford II. | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-07-22 04:31:11 -04:00
										 |  |  | USING: kernel math math.function-tools math.points math.vectors ;
 | 
					
						
							|  |  |  | IN: math.secant-method | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-07 01:24:32 -05:00
										 |  |  | ! Secant method of approximating roots | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-07-22 04:31:11 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : secant-solution ( x1 x2 function -- solution )
 | 
					
						
							|  |  |  |     [ eval ] curry bi@ linear-solution ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : secant-step ( x1 x2 func -- x2 x3 func )
 | 
					
						
							|  |  |  |     [ secant-solution ] 2keep swapd ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : secant-precision ( -- n ) 15 ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-07-22 04:31:11 -04:00
										 |  |  | PRIVATE>
 | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : secant-method ( left right function -- x )
 | 
					
						
							|  |  |  |     secant-precision [ secant-step ] times drop + 2 / ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-07-22 04:31:11 -04:00
										 |  |  | ! : close-enough? ( a b -- t/f ) - abs tiny-amount < ; | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | ! : secant-method2 ( left right function -- x ) | 
					
						
							|  |  |  |     ! 2over close-enough? | 
					
						
							|  |  |  |     ! [ drop average ] [ secant-step secant-method ] if  ; |