extra/benchmark/struct-arrays/struct-arrays.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.data classes.struct combinators.smart
   4 kernel math math.functions math.order math.parser sequences
   5 specialized-arrays io ;
   6 FROM: alien.c-types => float ;
   7 IN: benchmark.struct-arrays
   8
   9 STRUCT: point { x float } { y float } { z float } ;
  10
  11 SPECIALIZED-ARRAY: point
  12
  13 : xyz ( point -- x y z )
  14     [ x>> ] [ y>> ] [ z>> ] tri ; inline
  15
  16 : change-xyz ( point obj x: ( x obj -- x' ) y: ( y obj -- y' ) z: ( z obj -- z' ) -- point )
  17     tri-curry [ change-x ] [ change-y ] [ change-z ] tri* ; inline
  18
  19 : init-point ( n point -- n )
  20     over >fixnum >float
  21     [ sin >>x ] [ cos 3 * >>y ] [ sin sq 2 / >>z ] tri drop
  22     1 + ; inline
  23
  24 : make-points ( len -- points )
  25     point <c-array> dup 0 [ init-point ] reduce drop ; inline
  26
  27 : point-norm ( point -- norm )
  28     [ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline
  29
  30 : normalize-point ( point -- )
  31     dup point-norm [ / ] [ / ] [ / ] change-xyz drop ; inline
  32
  33 : normalize-points ( points -- )
  34     [ normalize-point ] each ; inline
  35
  36 : max-point ( point1 point2 -- point1 )
  37     [ x>> max ] [ y>> max ] [ z>> max ] change-xyz ; inline
  38
  39 : <zero-point> ( -- point )
  40     0 0 0 point boa ; inline
  41
  42 : max-points ( points -- point )
  43     <zero-point> [ max-point ] reduce ; inline
  44
  45 : print-point ( point -- )
  46     [ xyz [ number>string ] tri@ ] output>array ", " join print ; inline
  47
  48 : struct-arrays-bench ( len -- )
  49     make-points [ normalize-points ] [ max-points ] bi print-point ;
  50
  51 : struct-arrays-benchmark ( -- )
  52     10 [ 500000 struct-arrays-bench ] times ;
  53
  54 MAIN: struct-arrays-benchmark