Merge branch 'master' of http://factorforge.org/glguy.factor

extra/project-euler/100/100.factor

@@ -0,0 +1,7 @@
+USING: kernel sequences math.functions math ;
+IN: project-euler.100
+
+: euler100 ( -- n )
+    1 1
+    [ dup dup 1- * 2 * 10 24 ^ <= ]
+    [ tuck 6 * swap - 2 - ] [ ] while nip ;

extra/project-euler/151/151.factor

@@ -0,0 +1,40 @@
+! Copyright (c) 2008 Eric Mertens
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences combinators kernel sequences.lib math assocs namespaces ;
+IN: project-euler.151
+
+SYMBOL: table
+
+: (pick-sheet) ( seq i -- newseq )
+    [
+        <=> sgn
+        {
+            { -1 [ ] }
+            {  0 [ 1- ] }
+            {  1 [ 1+ ] }
+        } case
+    ] curry map-index ;
+
+DEFER: (euler151)
+
+: pick-sheet ( seq i -- res )
+    2dup swap nth dup zero? [
+        3drop 0
+    ] [
+        [ (pick-sheet) (euler151) ] dip *
+    ] if ;
+
+: (euler151) ( x -- y )
+    table get [ {
+        { { 0 0 0 1 } [ 0 ] }
+        { { 0 0 1 0 } [ { 0 0 0 1 } (euler151) 1+ ] }
+        { { 0 1 0 0 } [ { 0 0 1 1 } (euler151) 1+ ] }
+        { { 1 0 0 0 } [ { 0 1 1 1 } (euler151) 1+ ] }
+        [ [ dup length [ pick-sheet ] with map sum ] [ sum ] bi / ]
+     } case ] cache ;
+
+: euler151 ( -- n )
+    [
+        H{ } clone table set
+        { 1 1 1 1 } (euler151)
+    ] with-scope ;

extra/sequences/lib/lib.factor

@@ -131,6 +131,10 @@ MACRO: firstn ( n -- )
     [ find drop [ head-slice ] when* ] curry
     [ dup ] swap compose keep like ;
 
+: replicate ( seq quot -- newseq )
+    #! quot: ( -- obj )
+    [ drop ] swap compose map ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 <PRIVATE