diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 7c3bf27e9d..f359cfb7c4 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. ! Based on Slate's src/unfinished/interval.slate by Brian Rice. USING: accessors kernel sequences arrays math math.order -combinators generic ; +combinators generic random math.constants qualified ; +FROM: math.ranges => ; IN: math.intervals SYMBOL: empty-interval @@ -396,3 +397,37 @@ SYMBOL: incomparable [ to>> first2 [ 1- ] unless ] bi [a,b] ] unless ; + +> second not ; + +: open-right? ( interval -- ? ) to>> second not ; + +: integral-interval? ( interval -- ? ) + [ from>> ] [ to>> ] bi [ first integer? ] both? ; + +PRIVATE> + +ERROR: empty-random-interval ; + +: random-interval-integer ( interval -- n ) + [ [ to>> first ] [ open-right? [ 1- ] when ] bi ] + [ + [ from>> first ] + [ open-left? [ 1+ ] when ] bi + tuck - 1+ random + + ] bi ; + +: random-interval-float ( interval -- x ) + [ [ from>> first ] [ open-left? [ epsilon + ] when ] bi ] + [ [ to>> first ] [ open-right? [ epsilon - ] when ] bi ] bi + epsilon random [ empty-random-interval ] unless* ; + +M: interval random ( interval -- x ) + dup empty-interval = [ empty-random-interval ] when + dup integral-interval? [ + random-interval-integer + ] [ + random-interval-float + ] if ;