steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.extras: cleanup duplicate code.

db4
John Benediktsson 2013-04-22 11:13:32 -07:00
parent cead10cfb6
commit e3c5b53610
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
extra/math/extras/extras.factor
View File

@ -123,23 +123,24 @@ PRIVATE>
] curry map ] curry map
] if ; ] if ;
: 2pi-range ( n -- seq )
[ iota ] [ 1 - 2pi swap / ] bi v*n ;
: hanning ( n -- seq ) : hanning ( n -- seq )
dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [ dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [
[ iota ] [ 1 - 2pi swap / ] bi v*n 2pi-range [ cos -0.5 * 0.5 + ] map!
[ cos -0.5 * 0.5 + ] map!
] if ; ] if ;
: hamming ( n -- seq ) : hamming ( n -- seq )
dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [ dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [
[ iota ] [ 1 - 2pi swap / ] bi v*n 2pi-range [ cos -0.46 * 0.54 + ] map!
[ cos -0.46 * 0.54 + ] map!
] if ; ] if ;
: blackman ( n -- seq ) : blackman ( n -- seq )
dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [ dup 1 <= [ 1 = [ 1 1array ] [ { } ] if ] [
[ iota ] [ 1 - 2pi swap / ] bi v*n 2pi-range [
[ [ cos -0.5 * ] map ] [ [ 2 * cos 0.08 * ] map ] bi [ cos -0.5 * ] [ 2 * cos 0.08 * ] bi + 0.42 +
v+ 0.42 v+n ] map
] if ; ] if ;
: nan-sum ( seq -- n ) : nan-sum ( seq -- n )