move more stuff to contrib/math/
parent
4731a18d21
commit
97cf160071
|
@ -1,6 +1,7 @@
|
||||||
IN: dimensions
|
IN: dimensions
|
||||||
USING: parser sequences words compiler ;
|
USING: parser sequences words compiler ;
|
||||||
[
|
[
|
||||||
|
"contrib/math/utils.factor"
|
||||||
"contrib/math/combinatorics.factor"
|
"contrib/math/combinatorics.factor"
|
||||||
"contrib/math/analysis.factor"
|
"contrib/math/analysis.factor"
|
||||||
"contrib/math/polynomial.factor"
|
"contrib/math/polynomial.factor"
|
||||||
|
|
|
@ -0,0 +1,33 @@
|
||||||
|
IN: math
|
||||||
|
USING: errors kernel sequences ;
|
||||||
|
|
||||||
|
: deg>rad pi * 180 / ; inline
|
||||||
|
: rad>deg 180 * pi / ; inline
|
||||||
|
|
||||||
|
: lcm ( a b -- c )
|
||||||
|
#! Smallest integer such that c/a and c/b are both integers.
|
||||||
|
2dup gcd nip >r * r> /i ; foldable
|
||||||
|
|
||||||
|
: mod-inv ( x n -- y )
|
||||||
|
#! Compute the multiplicative inverse of x mod n.
|
||||||
|
gcd 1 = [ "Non-trivial divisor found" throw ] unless ;
|
||||||
|
foldable
|
||||||
|
|
||||||
|
: (^mod) ( n z w -- z^w )
|
||||||
|
1 swap [
|
||||||
|
1 number= [ dupd * pick mod ] when >r sq over mod r>
|
||||||
|
] each-bit 2nip ; inline
|
||||||
|
|
||||||
|
: ^mod ( z w n -- z^w )
|
||||||
|
#! Compute z^w mod n.
|
||||||
|
over 0 < [
|
||||||
|
[ >r neg r> ^mod ] keep mod-inv
|
||||||
|
] [
|
||||||
|
-rot (^mod)
|
||||||
|
] if ; foldable
|
||||||
|
|
||||||
|
: ** ( u v -- u*v' ) conjugate * ; inline
|
||||||
|
|
||||||
|
: c. ( v v -- x )
|
||||||
|
#! Complex inner product.
|
||||||
|
0 [ ** + ] 2reduce ;
|
|
@ -10,3 +10,7 @@ DEFER: fixnum-imm? ( -- ? )
|
||||||
|
|
||||||
DEFER: vregs ( -- n )
|
DEFER: vregs ( -- n )
|
||||||
#! Number of vregs
|
#! Number of vregs
|
||||||
|
|
||||||
|
DEFER: dual-fp/int-regs? ( -- ? )
|
||||||
|
#! Should fp parameters to fastcalls be loaded in integer
|
||||||
|
#! registers too? Only for PowerPC.
|
||||||
|
|
|
@ -28,8 +28,6 @@ M: number = ( n n -- ? ) number= ;
|
||||||
|
|
||||||
: conjugate ( z -- z* ) >rect neg rect> ; inline
|
: conjugate ( z -- z* ) >rect neg rect> ; inline
|
||||||
|
|
||||||
: ** ( u v -- u*v' ) conjugate * ; inline
|
|
||||||
|
|
||||||
: arg ( z -- arg )
|
: arg ( z -- arg )
|
||||||
#! Compute the complex argument.
|
#! Compute the complex argument.
|
||||||
>rect swap fatan2 ; inline
|
>rect swap fatan2 ; inline
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
! Copyright (C) 2004, 2005 Slava Pestov.
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: math
|
IN: math
|
||||||
USE: kernel
|
|
||||||
|
|
||||||
: i #{ 0 1 }# ; inline
|
: i #{ 0 1 }# ; inline
|
||||||
: -i #{ 0 -1 }# ; inline
|
: -i #{ 0 -1 }# ; inline
|
||||||
|
@ -9,6 +8,3 @@ USE: kernel
|
||||||
: -inf -1.0 0.0 / ; inline
|
: -inf -1.0 0.0 / ; inline
|
||||||
: e 2.7182818284590452354 ; inline
|
: e 2.7182818284590452354 ; inline
|
||||||
: pi 3.14159265358979323846 ; inline
|
: pi 3.14159265358979323846 ; inline
|
||||||
|
|
||||||
: deg>rad pi * 180 / ; inline
|
|
||||||
: rad>deg 180 * pi / ; inline
|
|
||||||
|
|
|
@ -21,15 +21,6 @@ UNION: integer fixnum bignum ;
|
||||||
#! such that a*x=d mod y.
|
#! such that a*x=d mod y.
|
||||||
swap 0 1 2swap (gcd) abs ; foldable
|
swap 0 1 2swap (gcd) abs ; foldable
|
||||||
|
|
||||||
: lcm ( a b -- c )
|
|
||||||
#! Smallest integer such that c/a and c/b are both integers.
|
|
||||||
2dup gcd nip >r * r> /i ; foldable
|
|
||||||
|
|
||||||
: mod-inv ( x n -- y )
|
|
||||||
#! Compute the multiplicative inverse of x mod n.
|
|
||||||
gcd 1 = [ "Non-trivial divisor found" throw ] unless ;
|
|
||||||
foldable
|
|
||||||
|
|
||||||
: (next-power-of-2) ( i n -- n )
|
: (next-power-of-2) ( i n -- n )
|
||||||
2dup >= [
|
2dup >= [
|
||||||
drop
|
drop
|
||||||
|
|
|
@ -45,16 +45,3 @@ M: integer ^ ( z w -- z^w )
|
||||||
] [
|
] [
|
||||||
dup 0 < [ neg ^ recip ] [ (integer^) ] if
|
dup 0 < [ neg ^ recip ] [ (integer^) ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: (^mod) ( n z w -- z^w )
|
|
||||||
1 swap [
|
|
||||||
1 number= [ dupd * pick mod ] when >r sq over mod r>
|
|
||||||
] each-bit 2nip ; inline
|
|
||||||
|
|
||||||
: ^mod ( z w n -- z^w )
|
|
||||||
#! Compute z^w mod n.
|
|
||||||
over 0 < [
|
|
||||||
[ >r neg r> ^mod ] keep mod-inv
|
|
||||||
] [
|
|
||||||
-rot (^mod)
|
|
||||||
] if ; foldable
|
|
||||||
|
|
|
@ -25,20 +25,19 @@ USING: arrays generic kernel sequences ;
|
||||||
2dup v* >r >r drop dup r> v* v- r> v+ ;
|
2dup v* >r >r drop dup r> v* v- r> v+ ;
|
||||||
|
|
||||||
: v. ( v v -- x )
|
: v. ( v v -- x )
|
||||||
#! Real inner product.
|
#! Dot product.
|
||||||
0 [ * + ] 2reduce ;
|
0 [ * + ] 2reduce ;
|
||||||
|
|
||||||
: c. ( v v -- x )
|
|
||||||
#! Complex inner product.
|
|
||||||
0 [ ** + ] 2reduce ;
|
|
||||||
|
|
||||||
: norm-sq ( v -- n ) 0 [ absq + ] reduce ;
|
: norm-sq ( v -- n ) 0 [ absq + ] reduce ;
|
||||||
|
|
||||||
: norm ( vec -- n ) norm-sq sqrt ;
|
: norm ( vec -- n )
|
||||||
|
#! Length of a vector.
|
||||||
|
norm-sq sqrt ;
|
||||||
|
|
||||||
: normalize ( vec -- vec ) dup norm v/n ;
|
: normalize ( vec -- uvec )
|
||||||
|
#! Unit vector with same direction as vec.
|
||||||
|
dup norm v/n ;
|
||||||
|
|
||||||
: proj ( u v -- w )
|
: proj ( u v -- w )
|
||||||
#! Orthogonal projection of u onto v.
|
#! Orthogonal projection of u onto v.
|
||||||
[ [ v. ] keep norm-sq v/n ] keep n*v ;
|
[ [ v. ] keep norm-sq v/n ] keep n*v ;
|
||||||
|
|
||||||
|
|
|
@ -86,7 +86,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
|
||||||
swap glMatrixMode glPushMatrix call glPopMatrix ; inline
|
swap glMatrixMode glPushMatrix call glPopMatrix ; inline
|
||||||
|
|
||||||
: gl-set-clip ( loc dim -- )
|
: gl-set-clip ( loc dim -- )
|
||||||
dup first2 >r >r
|
dup first2 1+ >r >r
|
||||||
over second swap second + height get swap - >r
|
over second swap second + height get swap - >r
|
||||||
first r> r> r> glScissor ;
|
first r> r> r> glScissor ;
|
||||||
|
|
||||||
|
|
|
@ -77,14 +77,14 @@ TUPLE: solid ;
|
||||||
|
|
||||||
: rect>screen ( shape -- x1 y1 x2 y2 )
|
: rect>screen ( shape -- x1 y1 x2 y2 )
|
||||||
>r origin get dup r> rect-dim v+
|
>r origin get dup r> rect-dim v+
|
||||||
[ first2 ] 2apply [ 1 - ] 2apply ;
|
[ first2 ] 2apply ( [ 1 - ] 2apply ) ;
|
||||||
|
|
||||||
! Solid pen
|
! Solid pen
|
||||||
M: solid draw-interior
|
M: solid draw-interior
|
||||||
drop dup bg gl-color rect-dim gl-fill-rect ;
|
drop dup bg gl-color rect-dim gl-fill-rect ;
|
||||||
|
|
||||||
M: solid draw-boundary
|
M: solid draw-boundary
|
||||||
drop dup fg gl-color rect-dim @{ 1 1 0 }@ v- gl-rect ;
|
drop dup fg gl-color rect-dim ( @{ 1 1 0 }@ v- ) gl-rect ;
|
||||||
|
|
||||||
! Rollover only
|
! Rollover only
|
||||||
TUPLE: rollover-only ;
|
TUPLE: rollover-only ;
|
||||||
|
|
Loading…
Reference in New Issue