diff --git a/extra/project-euler/148/148.factor b/extra/project-euler/148/148.factor new file mode 100644 index 0000000000..daad89a40c --- /dev/null +++ b/extra/project-euler/148/148.factor @@ -0,0 +1,24 @@ +! Copyright (c) 2008 Eric Mertens +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions sequences sequences.lib ; + +IN: project-euler.148 + +base7 ( x -- y ) + [ dup 0 > ] [ 7 /mod ] [ ] unfold nip ; + +: (use-digit) ( prev x index -- next ) + [ [ 1+ * ] [ sum-1toN 7 sum-1toN ] bi ] dip ^ * + ; + +PRIVATE> + +: (euler148) ( x -- y ) + >base7 0 [ (use-digit) ] reduce-index ; + +: euler148 ( -- y ) + 10 9 ^ (euler148) ; diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 15983329d6..8e3d394754 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -35,6 +35,10 @@ MACRO: firstn ( n -- ) #! quot: ( elt index -- obj ) prepare-index 2map ; inline +: reduce-index ( seq identity quot -- ) + #! quot: ( prev elt index -- next ) + swapd each-index ; inline + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : each-percent ( seq quot -- )