From 8eff6af3229f69a958118d5f7f4acf1ea7b77d63 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sat, 29 Dec 2007 14:09:50 -0500
Subject: [PATCH] Fix edge-case and perfect square errors with
 sum-proper-divisors

---
 extra/project-euler/021/021.factor       | 12 ++----------
 extra/project-euler/common/common.factor | 12 ++++++++++++
 2 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/extra/project-euler/021/021.factor b/extra/project-euler/021/021.factor
index cc0ba5b88d..c3859665e7 100644
--- a/extra/project-euler/021/021.factor
+++ b/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 ;
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 0a31df82b7..4c7987371d 100644
--- a/extra/project-euler/common/common.factor
+++ b/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 ;