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

extra/project-euler/021/021.factor

@@ -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 ;

extra/project-euler/common/common.factor

@@ -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 ;