steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up of common Project Euler code

db4
Aaron Schaefer 2008-11-03 20:14:37 -05:00
parent 9be67e7df7
commit 9d06315809
2 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/project-euler/common/common.factor
View File

@ -15,7 +15,7 @@ IN: project-euler.common
! log10 - #25, #134
! max-path - #18, #67
! nth-triangle - #12, #42
! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56
! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92
! palindrome? - #4, #36, #55
! pandigital? - #32, #38
! pentagonal? - #44, #45
@ -25,8 +25,8 @@ IN: project-euler.common
! [uad]-transform - #39, #75
: nth-pair ( n seq -- nth next )
2dup [ 1+ ] dip [ nth ] 2bi@ ;
: nth-pair ( seq n -- nth next )
tail-slice first2 ;
: perfect-square? ( n -- ? )
dup sqrt mod zero? ;
@ -34,7 +34,7 @@ IN: project-euler.common
<PRIVATE
: max-children ( seq -- seq )
[ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
[ dup length 1- [ nth-pair max , ] with each ] { } make ;
! Propagate one row into the upper one
: propagate ( bottom top -- newtop )
@ -84,8 +84,9 @@ PRIVATE>
! Not strictly needed, but it is nice to be able to dump the triangle after the
! propagation
: propagate-all ( triangle -- newtriangle )
reverse [ first dup ] keep rest [ propagate dup ] map nip reverse swap suffix ;
: propagate-all ( triangle -- new-triangle )
reverse [ first dup ] [ rest ] bi
[ propagate dup ] map nip reverse swap suffix ;
: sum-divisors ( n -- sum )
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
@ -108,8 +109,9 @@ PRIVATE>
! Optimized brute-force, is often faster than prime factorization
: tau* ( m -- n )
factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
dup sqrt >fixnum [1,b] [
factor-2s dup [ 1+ ]
[ perfect-square? -1 0 ? ]
[ dup sqrt >fixnum [1,b] ] tri* [
dupd mod zero? [ [ 2 + ] dip ] when
] each drop * ;

12
extra/project-euler/project-euler.factor
View File

@ -14,12 +14,12 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
project-euler.037 project-euler.038 project-euler.039 project-euler.040
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.045 project-euler.046 project-euler.047 project-euler.048
project-euler.052 project-euler.053 project-euler.056 project-euler.059
project-euler.067 project-euler.075 project-euler.079 project-euler.092
project-euler.097 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.052 project-euler.053 project-euler.055 project-euler.056
project-euler.059 project-euler.067 project-euler.075 project-euler.076
project-euler.079 project-euler.092 project-euler.097 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 ;
IN: project-euler
<PRIVATE