]> gitweb.factorcode.org Git - factor.git/commitdiff
Clean up some code to not use combinators.lib and sequences.lib
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 01:52:47 +0000 (19:52 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 18 Dec 2008 01:52:47 +0000 (19:52 -0600)
basis/math/statistics/statistics.factor
extra/game-input/game-input.factor
extra/game-input/iokit/iokit.factor
extra/joystick-demo/joystick-demo.factor
extra/math/miller-rabin/miller-rabin.factor
extra/random/blum-blum-shub/blum-blum-shub.factor
extra/reports/noise/noise.factor

index d2494ee32a7fdb28dcd6927a98b973ca8b4dfdd0..09caebcf0757bd81bcaf39194133002c45ae8907 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Michael Judge.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel math math.analysis math.functions sequences
-    sequences.lib sorting ;
+USING: arrays combinators kernel math math.analysis
+math.functions math.order sequences sorting ;
 IN: math.statistics
 
 : mean ( seq -- n )
@@ -20,6 +20,10 @@ IN: math.statistics
         [ midpoint@ ] keep nth
     ] if ;
 
+: minmax ( seq -- min max )
+    #! find the min and max of a seq in one pass
+    [ 1/0. -1/0. ] dip [ tuck [ min ] [ max ] 2bi* ] each ;
+
 : range ( seq -- n )
     minmax swap - ;
 
index fa70cef757c74bf535e56b2b485f709b65570916..46e3ba9e8dafc0522a33b528cc4bea5db32e7f64 100755 (executable)
@@ -1,6 +1,5 @@
 USING: arrays accessors continuations kernel system
-combinators.lib sequences namespaces init vocabs vocabs.loader
-combinators ;
+sequences namespaces init vocabs vocabs.loader combinators ;
 IN: game-input
 
 SYMBOLS: game-input-backend game-input-opened ;
@@ -59,9 +58,10 @@ HOOK: instance-id game-input-backend ( controller -- id )
     get-controllers [ product-id = ] with filter ;
 : find-controller-instance ( product-id instance-id -- controller/f )
     get-controllers [
+        tuck
         [ product-id  = ]
-        [ instance-id = ] bi, bi* and
-    ] 2with find nip ;
+        [ instance-id = ] 2bi* and
+    ] with with find nip ;
 
 HOOK: read-controller game-input-backend ( controller -- controller-state )
 HOOK: calibrate-controller game-input-backend ( controller -- )
index 8bfce00fb0ef42c89482040fede1d14b9db5e899..26f2c40464502f1576fa3bb32c8845ab6b4b1f45 100755 (executable)
@@ -1,7 +1,7 @@
 USING: cocoa cocoa.plists core-foundation iokit iokit.hid
 kernel cocoa.enumeration destructors math.parser cocoa.application 
 sequences locals combinators.short-circuit threads
-symbols namespaces assocs vectors arrays combinators
+namespaces assocs vectors arrays combinators
 core-foundation.run-loop accessors sequences.private
 alien.c-types math parser game-input ;
 IN: game-input.iokit
index 6a0b9f728f2b7d905c533c09d9bf6a3433a0d54c..9e457c7bddeaabca17e2d41dd3195a45a589374c 100755 (executable)
@@ -1,7 +1,7 @@
 USING: ui ui.gadgets sequences kernel arrays math colors
 ui.render math.vectors accessors fry ui.gadgets.packs game-input
 ui.gadgets.labels ui.gadgets.borders alarms
-calendar locals combinators.lib strings ui.gadgets.buttons
+calendar locals strings ui.gadgets.buttons
 combinators math.parser assocs threads ;
 IN: joystick-demo
 
@@ -51,9 +51,9 @@ M: axis-gadget pref-dim* drop SIZE ;
     [ (xy>loc) ] dip (z>loc) ;
 
 : move-axis ( gadget x y z -- )
-    (xyz>loc) rot
+    (xyz>loc) rot tuck
     [ indicator>>   (>>loc) ]
-    [ z-indicator>> (>>loc) ] bi, bi* ;
+    [ z-indicator>> (>>loc) ] 2bi* ;
 
 : move-pov ( gadget pov -- )
     swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ]
@@ -82,10 +82,10 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
     [ >>controller ] [ product-string <label> add-gadget ] bi ;
 
 : add-axis-gadget ( gadget shelf -- gadget shelf )
-    <axis-gadget> [ >>axis ] [ add-gadget-with-border ] bi, bi* ;
+    <axis-gadget> tuck [ >>axis ] [ add-gadget-with-border ] 2bi* ;
 
 : add-raxis-gadget ( gadget shelf -- gadget shelf )
-    <axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi, bi* ;
+    <axis-gadget> tuck [ >>raxis ] [ add-gadget-with-border ] 2bi* ;
 
 :: (add-button-gadgets) ( gadget shelf -- )
     gadget controller>> read-controller buttons>> length [
index def8a04738b7cea7c70dca57db3b79df72e02bd9..afaa66e68fbcc58122e55ad9e3741366802f00f5 100755 (executable)
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators combinators.lib io locals kernel math
-math.functions math.ranges namespaces random sequences
-hashtables sets ;
+USING: combinators io locals kernel math math.functions
+math.ranges namespaces random sequences hashtables sets ;
 IN: math.miller-rabin
 
 : >even ( n -- int ) dup even? [ 1- ] unless ; foldable
@@ -63,5 +62,7 @@ ERROR: too-few-primes ;
 
 : unique-primes ( numbits n -- seq )
     #! generate two primes
-    over 5 < [ too-few-primes ] when
-    [ [ drop random-prime ] with map ] [ all-unique? ] generate ;
+    swap
+    dup 5 < [ too-few-primes ] when
+    2dup [ random-prime ] curry replicate
+    dup all-unique? [ 2nip ] [ drop unique-primes ] if ;
index 8e9f0e25522e75de0015666e018c22ea04793ed5..dc764fd040b6894a3121b1b425479345dc9f36e7 100755 (executable)
@@ -1,6 +1,5 @@
 USING: kernel math sequences namespaces
-math.miller-rabin combinators.lib
-math.functions accessors random ;
+math.miller-rabin math.functions accessors random ;
 IN: random.blum-blum-shub
 
 ! Blum Blum Shub, n = pq, x_i+1 = x_i ^ 2 mod n
@@ -9,8 +8,12 @@ TUPLE: blum-blum-shub x n ;
 
 <PRIVATE
 
+: generate-bbs-prime ( numbits -- p )
+    dup random-prime dup 4 mod 3 =
+    [ nip ] [ drop generate-bbs-prime ] if ;
+
 : generate-bbs-primes ( numbits -- p q )
-    [ [ random-prime ] curry [ 4 mod 3 = ] generate ] dup bi ;
+    [ generate-bbs-prime ] [ generate-bbs-prime ] bi ;
 
 : next-bbs-bit ( bbs -- bit )
     dup [ x>> 2 ] [ n>> ] bi ^mod [ >>x drop ] [ 1 bitand ] bi ;
index 6a547ead24a3a1c9569c663794c45c65f7dc5ee6..1ce7f9c726cf4b5d426d0a5868ca6302bef444d2 100755 (executable)
@@ -3,7 +3,7 @@
 USING: accessors assocs math kernel shuffle generalizations\r
 words quotations arrays combinators sequences math.vectors\r
 io.styles prettyprint vocabs sorting io generic\r
-math.statistics math.order combinators.lib locals.types\r
+math.statistics math.order locals.types\r
 locals.definitions ;\r
 IN: reports.noise\r
 \r
@@ -21,19 +21,14 @@ IN: reports.noise
         { 2over 4 }\r
         { 2slip 2 }\r
         { 2swap 3 }\r
-        { 2with 2 }\r
-        { 2with* 3 }\r
         { 3curry 2 }\r
         { 3drop 1 }\r
         { 3dup 2 }\r
         { 3keep 3 }\r
         { 3nip 4 }\r
         { 3slip 3 }\r
-        { 3with 3 }\r
-        { 3with* 4 }\r
         { 4drop 2 }\r
         { 4dup 3 }\r
-        { 4slip 4 }\r
         { compose 1/2 }\r
         { curry 1/3 }\r
         { dip 1 }\r
@@ -74,9 +69,6 @@ IN: reports.noise
         { tuck 2 }\r
         { tuckd 4 }\r
         { with 1/2 }\r
-        { with* 2 }\r
-        { r> 1 }\r
-        { >r 1 }\r
 \r
         { bi 1/2 }\r
         { tri 1 }\r
@@ -113,18 +105,18 @@ M: array noise [ noise ] map vsum ;
     #! For very short words, noise doesn't count so much\r
     #! (so dup foo swap bar isn't penalized as badly).\r
     noise first2 {\r
-        { [ over 4 <= ] [ >r drop 0 r> ] }\r
-        { [ over 15 >= ] [ >r 2 * r> ] }\r
+        { [ over 4 <= ] [ [ drop 0 ] dip ] }\r
+        { [ over 15 >= ] [ [ 2 * ] dip ] }\r
         [ ]\r
     } cond\r
     {\r
         ! short words are easier to read\r
-        { [ dup 10 <= ] [ >r 2 / r> ] }\r
-        { [ dup 5 <= ] [ >r 3 / r> ] }\r
+        { [ dup 10 <= ] [ [ 2 / ] dip ] }\r
+        { [ dup 5 <= ] [ [ 3 / ] dip ] }\r
         ! long words are penalized even more\r
-        { [ dup 25 >= ] [ >r 2 * r> 20 max ] }\r
-        { [ dup 20 >= ] [ >r 5/3 * r> ] }\r
-        { [ dup 15 >= ] [ >r 3/2 * r> ] }\r
+        { [ dup 25 >= ] [ [ 2 * ] dip 20 max ] }\r
+        { [ dup 20 >= ] [ [ 5/3 * ] dip ] }\r
+        { [ dup 15 >= ] [ [ 3/2 * ] dip ] }\r
         [ ]\r
     } cond noise-factor ;\r
 \r