Fix edge-case and perfect square errors with sum-proper-divisors
parent
0dfddab0f6
commit
8eff6af322
|
@ -25,17 +25,9 @@ IN: project-euler.021
|
|||
! 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 -- ? )
|
||||
dup d { [ 2dup = not ] [ 2dup d = ] } && 2nip ;
|
||||
dup sum-proper-divisors
|
||||
{ [ 2dup = not ] [ 2dup sum-proper-divisors = ] } && 2nip ;
|
||||
|
||||
: euler021 ( -- answer )
|
||||
10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;
|
||||
|
|
|
@ -62,6 +62,18 @@ PRIVATE>
|
|||
: prime-factors ( n -- seq )
|
||||
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
|
||||
: tau ( n -- n )
|
||||
prime-factorization* flip second 1 [ 1+ * ] reduce ;
|
||||
|
|
Loading…
Reference in New Issue