]> gitweb.factorcode.org Git - factor.git/commitdiff
Add range methods
authorKeldan Chapman <keldan.chapman@gmail.com>
Wed, 6 Dec 2023 22:09:11 +0000 (23:09 +0100)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 7 Dec 2023 03:14:39 +0000 (19:14 -0800)
basis/math/vectors/ranges/ranges-tests.factor [new file with mode: 0644]
basis/math/vectors/ranges/ranges.factor [new file with mode: 0644]
basis/math/vectors/vectors.factor

diff --git a/basis/math/vectors/ranges/ranges-tests.factor b/basis/math/vectors/ranges/ranges-tests.factor
new file mode 100644 (file)
index 0000000..b61d2c4
--- /dev/null
@@ -0,0 +1,14 @@
+USING: math.vectors tools.test kernel ranges arrays ;
+
+{ { 3 12 21 30 } } [ 3 1 10 3 <range> n*v >array ] unit-test
+{ { 3 12 21 30  } } [ 1 10 3 <range> 3 v*n >array ] unit-test
+{ { 4 7 10 13 } } [ 3 1 10 3 <range> n+v >array ] unit-test
+{ { 4 7 10 13 } } [ 1 10 3 <range> 3 v+n >array ] unit-test
+{ { 2 -1 -4 -7 } } [ 3 1 10 3 <range> n-v >array ] unit-test
+{ { -2 1 4 7 } } [ 1 10 3 <range> 3 v-n >array ] unit-test
+{ { 1/3 4/3 7/3 10/3 } } [ 1 10 3 <range> 3 v/n >array ] unit-test
+{ { 6 11 16 21 } } [ 1 10 3 <range> 5 20 2 <range> v+ >array ] unit-test
+{ { -4 -3 -2 -1 } } [ 1 10 3 <range> 5 20 2 <range> v- >array ] unit-test
+
+{ { 3 11/2 8 21/2 } } [ 1 10 3 <range> 5 20 2 <range> vavg >array ] unit-test
+{ { -1 -4 -7 -10 } } [ 1 10 3 <range> vneg >array ] unit-test
diff --git a/basis/math/vectors/ranges/ranges.factor b/basis/math/vectors/ranges/ranges.factor
new file mode 100644 (file)
index 0000000..a8783a7
--- /dev/null
@@ -0,0 +1,30 @@
+! Copyright (C) 2023 Keldan Chapman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors kernel math math.order math.vectors ranges
+ranges.private ;
+IN: math.vectors
+
+M: range vneg >range< [ neg ] tri@ <range> ;
+
+M: range v+n [ >range< ] dip '[ [ _ + ] bi@ ] dip <range> ;
+M: range n+v swap v+n ;
+
+M: range v-n neg v+n ;
+M: range n-v >range< roll '[ [ _ swap - ] bi@ ] dip neg <range> ;
+
+M: range v*n [ >range< ] dip '[ _ * ] tri@ <range> ;
+M: range n*v swap v*n ;
+
+M: range v/n recip v*n ;
+
+M: range v+ over range? [
+        [ [ from>> ] bi@ + ]
+        [ [ length>> ] bi@ min ]
+        [ [ step>> ] bi@ + ] 2tri \ range boa
+    ] [ call-next-method ] if ;
+
+M: range v- >range< [ neg ] tri@ <range> v+ ;
+
+M: range vavg over range?
+    [ v+ 2 v/n ]
+    [ call-next-method ] if ;
index 00fe53f10f397d5f9e3ace89487addda81140102..7200f5c320f1c4b5fb94f6bcd6dc487136d71899 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2010 Slava Pestov, Joe Groff.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators grouping kernel math
-math.functions math.libm math.order sequences ;
+math.functions math.libm math.order sequences vocabs.loader ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors
 
@@ -301,3 +301,5 @@ PRIVATE>
 
 : angle-between ( v u -- a )
     [ normalize ] bi@ hdot acos ;
+
+{ "math.vectors" "ranges" } "math.vectors.ranges" require-when