From 5e41a5087038b53ead698b5fb4a0054847260ac5 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 20 Mar 2013 15:09:36 -0700
Subject: [PATCH] math.extras: adding ) and ] versions of linspace.
---
extra/math/extras/extras-docs.factor | 12 +++++++++--
extra/math/extras/extras-tests.factor | 3 ++-
extra/math/extras/extras.factor | 29 +++++++++++++++++++++------
3 files changed, 35 insertions(+), 9 deletions(-)
diff --git a/extra/math/extras/extras-docs.factor b/extra/math/extras/extras-docs.factor
index 605cb76596..0a4dbadb2c 100644
--- a/extra/math/extras/extras-docs.factor
+++ b/extra/math/extras/extras-docs.factor
@@ -58,10 +58,18 @@ HELP: sinc
{ $description "Returns the " { $link sinc } " function, calculated according to " { $snippet "sin(pi * x) / (pi * x)" } ". The name " { $link sinc } " is short for \"sine cardinal\" or \"sinus cardinalis\"." }
{ $notes { $snippet "0 sinc" } " is the limit value of 1." } ;
-HELP: linspace
+HELP: linspace)
+{ $values { "from" number } { "to" number } { "points" number } { "seq" sequence } }
+{ $description "Return evenly spaced numbers over a specified interval " { $snippet "[from,to)" } "." } ;
+
+HELP: linspace]
{ $values { "from" number } { "to" number } { "points" number } { "seq" sequence } }
{ $description "Return evenly spaced numbers over a specified interval " { $snippet "[from,to]" } "." } ;
-HELP: logspace
+HELP: logspace)
+{ $values { "from" number } { "to" number } { "points" number } { "base" number } { "seq" sequence } }
+{ $description "Return evenly spaced numbers on a log scaled interval " { $snippet "[base^from,base^to)" } "." } ;
+
+HELP: logspace]
{ $values { "from" number } { "to" number } { "points" number } { "base" number } { "seq" sequence } }
{ $description "Return evenly spaced numbers on a log scaled interval " { $snippet "[base^from,base^to]" } "." } ;
diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 28d0188133..62a170276e 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -78,4 +78,5 @@ IN: math.extras.test
{ 0 1 0 0 2 3 }
} [ { 1 2 1 1 3 4 } unique-indices ] unit-test
-{ { 1 10+3/4 20+1/2 30+1/4 40 } } [ 1 40 5 linspace >array ] unit-test
+{ { 1 8+4/5 16+3/5 24+2/5 32+1/5 } } [ 1 40 5 linspace) >array ] unit-test
+{ { 1 10+3/4 20+1/2 30+1/4 40 } } [ 1 40 5 linspace] >array ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 96312b3329..9ead1a97b9 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -4,8 +4,8 @@
USING: arrays assocs assocs.extras combinators.short-circuit fry
grouping kernel locals math math.combinatorics math.constants
math.functions math.order math.primes math.ranges
-math.statistics math.vectors memoize random sequences
-sequences.extras sets sorting ;
+math.ranges.private math.statistics math.vectors memoize
+random sequences sequences.extras sets sorting ;
IN: math.extras
@@ -199,8 +199,25 @@ PRIVATE>
: unique-indices ( seq -- unique indices )
[ members ] keep over dup length iota H{ } zip-as '[ _ at ] map ;
-: linspace ( from to points -- seq )
- 1 - [ 2dup swap - ] dip / <range> ;
+<PRIVATE
-: logspace ( from to points base -- seq )
- [ linspace ] dip swap n^v ;
+: steps ( from to point -- from to step )
+ [ 2dup swap - ] dip / ; inline
+
+PRIVATE>
+
+: linspace) ( from to points -- seq )
+ steps ,b) <range> ;
+
+: linspace] ( from to points -- seq )
+ {
+ { [ dup 1 < ] [ 3drop { } ] }
+ { [ dup 1 = ] [ 2drop 1array ] }
+ [ steps <range> ]
+ } cond ;
+
+: logspace) ( from to points base -- seq )
+ [ linspace) ] dip swap n^v ;
+
+: logspace] ( from to points base -- seq )
+ [ linspace] ] dip swap n^v ;