Solution to Project Euler problem 112

extra/project-euler/112/112-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.112 tools.test ;
+IN: project-euler.112.tests
+
+[ 1587000 ] [ euler112 ] unit-test

extra/project-euler/112/112.factor

@@ -0,0 +1,52 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math project-euler.common sequences sorting ;
+IN: project-euler.112
+
+! http://projecteuler.net/index.php?section=problems&id=112
+
+! DESCRIPTION
+! -----------
+
+! Working from left-to-right if no digit is exceeded by the digit to its left
+! it is called an increasing number; for example, 134468.
+
+! Similarly if no digit is exceeded by the digit to its right it is called a
+! decreasing number; for example, 66420.
+
+! We shall call a positive integer that is neither increasing nor decreasing a
+! "bouncy" number; for example, 155349.
+
+! Clearly there cannot be any bouncy numbers below one-hundred, but just over
+! half of the numbers below one-thousand (525) are bouncy. In fact, the least
+! number for which the proportion of bouncy numbers first reaches 50% is 538.
+
+! Surprisingly, bouncy numbers become more and more common and by the time we
+! reach 21780 the proportion of bouncy numbers is equal to 90%.
+
+! Find the least number for which the proportion of bouncy numbers is exactly
+! 99%.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: bouncy? ( n -- ? )
+    number>digits dup natural-sort
+    [ = not ] [ reverse = not ] 2bi and ;
+
+PRIVATE>
+
+: euler112 ( -- answer )
+    0 0 0 [
+        2dup swap 99 * = not
+    ] [
+        [ 1 + ] 2dip pick bouncy? [ 1 + ] [ [ 1 + ] dip ] if
+    ] do while 2drop ;
+
+! [ euler112 ] 100 ave-time
+! 2749 ms ave run time - 33.76 SD (100 trials)
+
+SOLUTION: euler112

extra/project-euler/project-euler.factor

@@ -19,10 +19,11 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.059 project-euler.063 project-euler.067 project-euler.069
     project-euler.071 project-euler.073 project-euler.075 project-euler.076
     project-euler.079 project-euler.085 project-euler.092 project-euler.097
-    project-euler.099 project-euler.100 project-euler.116 project-euler.117
-    project-euler.134 project-euler.148 project-euler.150 project-euler.151
-    project-euler.164 project-euler.169 project-euler.173 project-euler.175
-    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.099 project-euler.100 project-euler.112 project-euler.116
+    project-euler.117 project-euler.134 project-euler.148 project-euler.150
+    project-euler.151 project-euler.164 project-euler.169 project-euler.173
+    project-euler.175 project-euler.186 project-euler.190 project-euler.203
+    project-euler.215 ;
 IN: project-euler
 
 <PRIVATE