# Paste: My first Factor program

Author: alexshendi factor Sun, 28 Oct 2012 11:07:52
Plain Text |
```! Copyright (C) 2012 Alexander Shendi
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
```