Merge branch 'master' of http://factorforge.org/glguy.factor
commit
bc95aa8585
|
@ -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
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: sum-1toN ( n -- sum )
|
||||||
|
dup 1+ * 2/ ; inline
|
||||||
|
|
||||||
|
: >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) ;
|
|
@ -35,6 +35,10 @@ MACRO: firstn ( n -- )
|
||||||
#! quot: ( elt index -- obj )
|
#! quot: ( elt index -- obj )
|
||||||
prepare-index 2map ; inline
|
prepare-index 2map ; inline
|
||||||
|
|
||||||
|
: reduce-index ( seq identity quot -- )
|
||||||
|
#! quot: ( prev elt index -- next )
|
||||||
|
swapd each-index ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: each-percent ( seq quot -- )
|
: each-percent ( seq quot -- )
|
||||||
|
|
Loading…
Reference in New Issue