| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | ! Copyright (C) 2008 Doug Coleman. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2009-04-17 12:14:16 -04:00
										 |  |  | USING: kernel math math.ranges math.vectors namespaces | 
					
						
							|  |  |  | sequences ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: math.numerical-integration | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-07 00:12:38 -05:00
										 |  |  | SYMBOL: num-steps | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 180 num-steps set-global
 | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : setup-simpson-range ( from to -- frange )
 | 
					
						
							|  |  |  |     2dup swap - num-steps get / <range> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : generate-simpson-weights ( seq -- seq )
 | 
					
						
							| 
									
										
										
										
											2008-12-07 00:12:38 -05:00
										 |  |  |     length 2 / 2 - { 2 4 } <repetition> concat
 | 
					
						
							|  |  |  |     { 1 4 } { 1 } surround ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-04-17 12:14:16 -04:00
										 |  |  | : integrate-simpson ( from to quot -- x )
 | 
					
						
							| 
									
										
										
										
											2008-10-03 03:19:03 -04:00
										 |  |  |     [ setup-simpson-range dup ] dip  | 
					
						
							|  |  |  |     map dup generate-simpson-weights | 
					
						
							| 
									
										
										
										
											2009-04-17 12:14:16 -04:00
										 |  |  |     v. swap [ third ] keep first - 6 / * ; inline
 |