Paste: My first Factor program

! Copyright (C) 2012 Alexander Shendi
! See http://factorcode.org/license.txt for BSD license.
USING: kernel system combinators generalizations sequences 
       math math.constants math.functions math.matrices math.ranges math.vectors 
       formatting io.encodings.utf8 io.files prettyprint ;
IN: windfun

: default-range ( -- range ) 0 2 pi * pi 10 / - pi 10 / <range> ; inline

: grid ( quot: ( ... x y -- ... z ) -- seq ) 
  default-range default-range rot cartesian-map
; inline

: grid-avg ( seq -- seq1 ) 
  dup length dup [ 0.0 ] replicate  ! seq n seq1 
  rot swap [ v+ ] reduce n/v 
; inline

: v-avg ( v -- x ) dup length swap 0.0 [ + ] reduce n/v ;

: wind-fun-stator ( w1 offs -- quot: ( ... x y -- ... z ) )
  swap 2 * pi / swap [ drop swap - dup cos swap 3 * cos 0.3333 * - * ] 2curry 
; inline


: wind-fun-rotor ( w2 -- quot: ( ... x y -- ... z ) )
  2 * pi / [ - dup cos swap 3 * cos 0.3333 * - * ] curry
; inline

: perm-coeff-1 ( k alphai -- z )
  swap dup 0 = [ drop ] [ swap dup rot * pi * 0.5 * sin 4 * pi / swap / ] if
; inline

: perm-coeffs ( delta alphai -- seq )
  0 6 2 <range> swap [ perm-coeff-1 ] curry map n/v
; inline
 

: perm-fun ( delta alphai -- quot: ( ... x y -- ... z ) ) 
  perm-coeffs [ rot rot -  0 6 2 <range> [ over * cos ] map nip v. ] curry
; inline  

: mutual-inductances-1 ( gnx gny gperm -- g1 g2 g3 g4 )
  { { 1 } } 3sequence 
  { [ first3 drop m*  grid-avg ] [ first3 nip m* grid-avg ] [ first3 rot drop m* grid-avg ] [ first3 nip nip  grid-avg ] } cleave
; inline

: mutual-inductances ( gnx gny gperm -- v )
  mutual-inductances-1  ! <Nx*Ny> <P*Nx> <P*Ny> <P>
  rot rot v* swap v/ v-
; inline
  
: test-ind ( -- )
  7 0.0 wind-fun-stator dup 
  0.00035 0.61 perm-fun
  [ grid ] 3 napply 
  mutual-inductances 
  0.0  2.0 pi * pi 10 / - pi 10 / <range> swap  [ "%e %e" sprintf ] 2map
  "./induct.plot" utf8 set-file-lines
; inline