From: Keldan Chapman <keldan.chapman@gmail.com>
Date: Wed, 6 Dec 2023 22:09:11 +0000 (+0100)
Subject: Add range methods
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=a0c1b34f5a6f81302bb1a6a519823b481b1eef25

Add range methods
---

diff --git a/basis/math/vectors/ranges/ranges-tests.factor b/basis/math/vectors/ranges/ranges-tests.factor
new file mode 100644
index 0000000000..b61d2c45ed
--- /dev/null
+++ b/basis/math/vectors/ranges/ranges-tests.factor
@@ -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
index 0000000000..a8783a7d9e
--- /dev/null
+++ b/basis/math/vectors/ranges/ranges.factor
@@ -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 ;
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index 00fe53f10f..7200f5c320 100644
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -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