| 
									
										
										
										
											2009-08-28 06:21:54 -04:00
										 |  |  | ! Copyright (C) 2009 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: accessors classes.struct combinators.smart fry kernel | 
					
						
							|  |  |  | math math.functions math.order math.parser sequences | 
					
						
							| 
									
										
										
										
											2009-09-09 23:33:34 -04:00
										 |  |  | specialized-arrays io ;
 | 
					
						
							| 
									
										
										
										
											2009-09-27 16:11:21 -04:00
										 |  |  | FROM: alien.c-types => float ;
 | 
					
						
							| 
									
										
										
										
											2009-08-28 06:21:54 -04:00
										 |  |  | IN: benchmark.struct-arrays | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | STRUCT: point { x float } { y float } { z float } ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-09-09 23:33:34 -04:00
										 |  |  | SPECIALIZED-ARRAY: point | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-08-28 06:21:54 -04:00
										 |  |  | : xyz ( point -- x y z )
 | 
					
						
							|  |  |  |     [ x>> ] [ y>> ] [ z>> ] tri ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : change-xyz ( point obj x: ( x obj -- x' ) y: ( y obj -- y' ) z: ( z obj -- z' ) -- point )
 | 
					
						
							|  |  |  |     tri-curry [ change-x ] [ change-y ] [ change-z ] tri* ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : init-point ( n point -- n )
 | 
					
						
							|  |  |  |     over >fixnum >float
 | 
					
						
							|  |  |  |     [ sin >>x ] [ cos 3 * >>y ] [ sin sq 2 / >>z ] tri drop
 | 
					
						
							|  |  |  |     1 + ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : make-points ( len -- points )
 | 
					
						
							| 
									
										
										
										
											2009-09-09 23:33:34 -04:00
										 |  |  |     <point-array> dup 0 [ init-point ] reduce drop ; inline
 | 
					
						
							| 
									
										
										
										
											2009-08-28 06:21:54 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : point-norm ( point -- norm )
 | 
					
						
							|  |  |  |     [ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : normalize-point ( point -- )
 | 
					
						
							|  |  |  |     dup point-norm [ / ] [ / ] [ / ] change-xyz drop ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : normalize-points ( points -- )
 | 
					
						
							|  |  |  |     [ normalize-point ] each ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : max-point ( point1 point2 -- point1 )
 | 
					
						
							|  |  |  |     [ x>> max ] [ y>> max ] [ z>> max ] change-xyz ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <zero-point> ( -- point )
 | 
					
						
							|  |  |  |     0 0 0 point <struct-boa> ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : max-points ( points -- point )
 | 
					
						
							|  |  |  |     <zero-point> [ max-point ] reduce ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : print-point ( point -- )
 | 
					
						
							|  |  |  |     [ xyz [ number>string ] tri@ ] output>array ", " join print ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : struct-array-benchmark ( len -- )
 | 
					
						
							|  |  |  |     make-points [ normalize-points ] [ max-points ] bi print-point ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-09-13 18:19:59 -04:00
										 |  |  | : main ( -- ) 10 [ 500000 struct-array-benchmark ] times ;
 | 
					
						
							| 
									
										
										
										
											2009-08-28 06:21:54 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | MAIN: main |