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

Fix edge-case and perfect square errors with sum-proper-divisors

db4
Aaron Schaefer 2007-12-29 14:09:50 -05:00
parent 0dfddab0f6
commit 8eff6af322
2 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,17 +25,9 @@ IN: project-euler.021
! SOLUTION ! SOLUTION
! -------- ! --------
<PRIVATE
: d ( n -- sum )
dup sqrt >fixnum 2 swap [a,b] [
[ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each drop
] { } make sum 1+ ;
PRIVATE>
: amicable? ( n -- ? ) : amicable? ( n -- ? )
dup d { [ 2dup = not ] [ 2dup d = ] } && 2nip ; dup sum-proper-divisors
{ [ 2dup = not ] [ 2dup sum-proper-divisors = ] } && 2nip ;
: euler021 ( -- answer ) : euler021 ( -- answer )
10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ; 10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;

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

@ -62,6 +62,18 @@ PRIVATE>
: prime-factors ( n -- seq ) : prime-factors ( n -- seq )
prime-factorization prune >array ; prime-factorization prune >array ;
: (sum-divisors) ( n -- sum )
dup sqrt >fixnum [1,b] [
[ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
] { } make sum ;
: sum-divisors ( n -- sum )
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
: sum-proper-divisors ( n -- sum )
dup sum-divisors swap - ;
! The divisor function, counts the number of divisors ! The divisor function, counts the number of divisors
: tau ( n -- n ) : tau ( n -- n )
prime-factorization* flip second 1 [ 1+ * ] reduce ; prime-factorization* flip second 1 [ 1+ * ] reduce ;