]> gitweb.factorcode.org Git - factor.git/commitdiff
benchmark.ant: adding the "ant puzzle" benchmark. See #153.
authorJohn Benediktsson <mrjbq7@gmail.com>
Sun, 25 Sep 2011 19:25:52 +0000 (12:25 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 25 Sep 2011 19:25:52 +0000 (12:25 -0700)
extra/benchmark/ant/ant.factor [new file with mode: 0644]

diff --git a/extra/benchmark/ant/ant.factor b/extra/benchmark/ant/ant.factor
new file mode 100644 (file)
index 0000000..0a5aae2
--- /dev/null
@@ -0,0 +1,57 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors combinators fry hash-sets hashtables kernel
+locals math math.parser sequences sets utils vectors ;
+
+IN: ant
+
+! There is an ant which can walk around on a planar grid. The ant
+! can move one space at a time left, right, up or down. That is,
+! from (x, y) the ant can go to (x+1, y), (x-1, y), (x, y+1), and
+! (x, y-1).
+!
+! Points where the sum of the digits of the x coordinate plus the
+! sum of the digits of the y coordinate are greater than 25 are
+! inaccessible to the ant.  For example, the point (59,79) is
+! inaccessible because 5 + 9 + 7 + 9 = 30, which is greater than
+! 25.
+!
+! How many points can the ant access if it starts at (1000, 1000),
+! including (1000, 1000) itself?
+
+: sum-digits ( n -- x )
+    0 swap [ dup zero? ] [ 10 /mod swap [ + ] dip ] until drop ;
+
+! FIXME: Find out why this makes it 430 times slower
+! TUPLE: point x y ;
+! C: <point> point
+
+USE: alien.c-types
+USE: classes.struct
+STRUCT: point { x uint } { y uint } ;
+: <point> ( x y -- point ) point <struct-boa> ; inline
+
+: walkable? ( point -- ? )
+    [ x>> ] [ y>> ] bi [ sum-digits ] bi@ + 25 <= ; inline
+
+:: ant ( -- total )
+    200000 <hashtable> hash-set boa :> seen
+    100000 <vector> :> stack
+    0 :> total!
+
+    1000 1000 <point> stack push
+
+    [ stack empty? ] [
+        stack pop :> p
+        p seen in? [
+            p seen adjoin
+            p walkable? [
+                total 1 + total!
+                p clone [ 1 + ] change-x stack push
+                p clone [ 1 - ] change-x stack push
+                p clone [ 1 + ] change-y stack push
+                p clone [ 1 - ] change-y stack push
+            ] when
+        ] unless
+    ] until total ;