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

Changed to not modify the core vocabularies math and sequences 

All external words are in the vocabulary math-contrib, while internal words are in their respective filename-internal
Moved dimensional analysis files to contrib/units
cvs
Doug Coleman 2005-10-23 23:07:16 +00:00
parent c443f5c76a
commit 699ebb78ea
10 changed files with 13 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/math/analysis.factor
View File

@ -1,7 +1,5 @@
IN: analysis-internals
USING: kernel sequences errors namespaces math ;
USING: test ;
IN: math-internals
: Z:(-inf,0]? ( n -- bool )
#! nonpositive integer
@ -37,7 +35,7 @@ IN: math-internals
: gamma-neg ( gamma[abs[x]] x -- gamma[x] )
dup pi * sin * * pi neg swap / ; inline
IN: math
IN: math-contrib
: gamma ( x -- gamma[x] )
#! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt

5
contrib/math/combinatorics.factor
View File

@ -1,6 +1,5 @@
USING: kernel sequences errors namespaces ;
USING: test ;
IN: math
IN: math-contrib
USING: kernel sequences errors namespaces math ;
: (0..n] ( n -- (0..n] ) 1+ 1 swap <range> ; inline
: [1..n] ( n -- [1..n] ) (0..n] ; inline

9
contrib/math/constants.factor
View File

@ -1,9 +0,0 @@
USING: kernel math dimensional-analysis units ;
! From: http://physics.nist.gov/constants
IN: physical-constants
! speed of light in vacuum
: c 299792458 m/s ;
! : c0 299792458:m/s ; ! same as c
! : c-vacuum 299792458:m/s ; ! same as c

83
contrib/math/dimensional-analysis.factor
View File

@ -1,83 +0,0 @@
USING: physical-constants conversions ;
USING: kernel prettyprint io sequences words lists vectors inspector math errors ;
IN: dimensional-analysis
IN: sequences
: seq-diff ( seq1 seq2 -- seq2-seq1 )
[ swap member? not ] subset-with ; flushable
: seq-intersect ( seq1 seq2 -- seq1/\seq2 )
[ swap member? ] subset-with ; flushable
IN: dimensional-analysis
TUPLE: dimensioned val top bot ;
C: dimensioned
[ set-dimensioned-bot ] keep
[ set-dimensioned-top ] keep
over number? [ "dimensioned must be a number" throw ] unless
[ set-dimensioned-val ] keep ;
: remove-one ( obj seq -- seq )
[ index ] keep over -1 = [
2drop
] [
[ 0 -rot <slice> ] 2keep
>r 1+ r> [ length ] keep <slice> append
] if ;
: dimensions ( dimensioned -- top bot )
dup >r dimensioned-top r> dimensioned-bot ;
: 2remove-one ( obj seq seq -- seq seq )
pick swap remove-one >r remove-one r> ;
: symbolic-reduce ( seq seq -- seq seq )
[ seq-intersect ] 2keep rot dup empty? [
drop
] [
first -rot 2remove-one symbolic-reduce
] if ;
: reduce-units ( dimensioned -- )
dup dimensions symbolic-reduce pick set-dimensioned-bot swap set-dimensioned-top ;
: 2reduce-units ( d d -- )
>r dup reduce-units r> dup reduce-units ;
: 2val ( d d -- )
>r dimensioned-val r> dimensioned-val ;
: =units?
>r dimensions 2list r> dimensions 2list = ;
: d+ ( d d -- )
2dup =units? [
"d+: dimensions must be the same" throw
] unless
dup dimensions
>r >r 2val + r> r> <dimensioned> ;
: d- ( d d -- )
2dup =units? [
"d-: dimensions must be the same" throw
] unless
dup dimensions
>r >r 2val - r> r> <dimensioned> ;
: add-dimensions ( d d -- d )
>r dimensions r> dimensions >r swap >r append r> r> append 0 -rot <dimensioned> ;
: (d*)
>r add-dimensions r> over set-dimensioned-val dup reduce-units ;
: d* ( d d -- )
2dup 2val * (d*) ;
: d/ ( d d -- )
2dup 2val / (d*) ;

5
contrib/math/load.factor
View File

@ -7,10 +7,7 @@ USING: parser sequences words compiler ;
"contrib/math/polynomial.factor"
"contrib/math/quaternions.factor"
"contrib/math/matrices.factor"
! "contrib/math/dimensional-analysis.factor"
! "contrib/math/units.factor"
! "contrib/math/constants.factor"
] [ run-file ] each
"math-contrib" words [ try-compile ] each

4
contrib/math/matrices.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: math
USING: arrays generic kernel sequences ;
IN: math-contrib
USING: arrays generic kernel sequences math ;
! Matrices
: zero-matrix ( m n -- matrix )

14
contrib/math/polynomial.factor
View File

@ -1,14 +1,6 @@
IN: polynomial-internals
USING: kernel sequences vectors math math-internals namespaces ;
USING: prettyprint inspector io test ;
! p+ p- n*p p* p/mod pgcd
IN: math
: max-length ( seq seq -- n )
[ length ] 2apply max ; flushable
IN: math-internals
: 2length ( seq seq -- ) [ length ] 2apply ;
: zero-vector ( n -- vector ) 0 <repeated> >vector ;
@ -34,7 +26,7 @@ IN: math-internals
: pextend ( p p -- p p )
2dup 2zero-extend ;
IN: math
IN: math-contrib
: p= ( p p -- )
pextend = ;
@ -74,7 +66,7 @@ IN: math
: p-sq ( p -- p-sq )
dup p* ;
IN: math-internals
IN: polynomial-internals
: pop-front ( seq -- seq )
1 swap tail ;

4
contrib/math/quaternions.factor
View File

@ -7,7 +7,7 @@
! Quaternions are represented as pairs of complex numbers,
! using the identity: (a+bi)+(c+di)j = a+bi+cj+dk.
USING: arrays kernel math sequences ;
IN: math-internals
IN: quaternions-internals
: 2q [ first2 ] 2apply ; inline
@ -15,7 +15,7 @@ IN: math-internals
: q*b 2q >r ** swap r> * + ; inline
IN: math
IN: math-contrib
: q* ( u v -- u*v )
#! Multiply quaternions.

47
contrib/math/units.factor
View File

@ -1,47 +0,0 @@
USING: math dimensional-analysis ;
IN: units
SYMBOL: mm
SYMBOL: cm
SYMBOL: dm
SYMBOL: m
SYMBOL: km
: mm>m 1000 / ;
: m>mm 1000 * ;
: cm>m 100 / ;
: m>cm 100 * ;
: dm>m 10 / ;
: m>dm 10 * ;
: km>m 1000 * ;
: m>km 1000 / ;
SYMBOL: ms
SYMBOL: s
: ms>s 1000 / ;
: s>ms 1000 * ;
: m { m } { } <dimensioned> ;
: km { km } { } <dimensioned> ;
: ms { ms } { } <dimensioned> ;
: s { s } { } <dimensioned> ;
: m/s { m } { s } <dimensioned> ;
: m/s^2 { m } { s s } <dimensioned> ;
SYMBOL: kg
: kg { kg } { } <dimensioned> ;
! SYMBOL: N ! newtons
! : N { N } { } <dimensioned> ;
! Autogenerated plz
: mm>km mm>m m>km ; ! : mm>km 1000 / 1000 / ;

2
contrib/math/utils.factor
View File

@ -1,4 +1,4 @@
IN: math
IN: math-contrib
USING: errors kernel sequences ;
: deg>rad pi * 180 / ; inline