June 2018 Update

Task/Amicable-pairs/Ada/amicable-pairs.ada

@@ -0,0 +1,32 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Amicable is
+
+   function Sum_Of_Factors(Num : Integer) return Integer is
+      Sum : Integer := 1;
+      Test_Nr : Integer := 2;
+   begin
+      loop
+	 if Num mod Test_Nr = 0 then
+	    Sum := Sum + Test_Nr;
+	    if Test_Nr * Test_Nr /= Num then
+	       Sum := Sum + Num / Test_Nr;
+	       end if;
+	 end if;
+	 Test_Nr := Test_Nr + 1;
+	 exit when Test_Nr ** 2 > Num;
+      end loop;
+      return Sum;
+   end Sum_Of_Factors;
+
+   Num2 : Integer;
+begin
+   for Num1 in 4 .. 20_000 loop
+      Num2 := Sum_Of_Factors(Num1);
+      if Num1 < Num2 then
+	 if Num1 = Sum_Of_Factors(Num2) then
+	   Put_Line(Integer'Image(Num1) & "," & Integer'Image(Num2));
+	 end if;
+      end if;
+   end loop;
+end Amicable;

Task/Amicable-pairs/AppleScript/amicable-pairs-1.applescript

@@ -1,38 +1,39 @@
+-- AMICABLE PAIRS ------------------------------------------------------------
+
 -- amicablePairsUpTo :: Int -> Int
 on amicablePairsUpTo(max)
 
     -- amicable :: [Int] -> Int -> Int -> [Int] -> [Int]
     script amicable
-        on lambda(lstAccumulator, m, n, lstSums)
+        on |λ|(a, m, n, lstSums)
             if (m > n) and (m ≤ max) and ((item m of lstSums) = n) then
-                lstAccumulator & [[n, m]]
+                a & [[n, m]]
             else
-                lstAccumulator
+                a
             end if
-        end lambda
+        end |λ|
     end script
 
     -- divisorsSummed :: Int -> Int
     script divisorsSummed
         -- sum :: Int -> Int -> Int
         script sum
-            on lambda(a, b)
+            on |λ|(a, b)
                 a + b
-            end lambda
+            end |λ|
         end script
 
-        on lambda(n)
+        on |λ|(n)
             foldl(sum, 0, properDivisors(n))
-        end lambda
+        end |λ|
     end script
 
-    foldl(amicable, [], ¬
-        map(divisorsSummed, range(1, max)))
+    foldl(amicable, {}, ¬
+        map(divisorsSummed, enumFromTo(1, max)))
 end amicablePairsUpTo
 
 
--- TEST
-
+-- TEST ----------------------------------------------------------------------
 on run
 
     amicablePairsUpTo(20000)
@@ -40,23 +41,23 @@ on run
 end run
 
 
--- PROPER DIVISORS
+-- PROPER DIVISORS -----------------------------------------------------------
 
 -- properDivisors :: Int -> [Int]
 on properDivisors(n)
 
     -- isFactor :: Int -> Bool
     script isFactor
-        on lambda(x)
+        on |λ|(x)
             n mod x = 0
-        end lambda
+        end |λ|
     end script
 
     -- integerQuotient :: Int -> Int
     script integerQuotient
-        on lambda(x)
+        on |λ|(x)
             (n / x) as integer
-        end lambda
+        end |λ|
     end script
 
     if n = 1 then
@@ -67,7 +68,7 @@ on properDivisors(n)
         set blnPerfectSquare to intRoot = realRoot
 
         -- Factors up to square root of n,
-        set lows to filter(isFactor, range(1, intRoot))
+        set lows to filter(isFactor, enumFromTo(1, intRoot))
 
         -- and quotients of these factors beyond the square root,
         -- excluding n itself (last item)
@@ -76,10 +77,21 @@ on properDivisors(n)
     end if
 end properDivisors
 
+-- GENERIC FUNCTIONS ---------------------------------------------------------
 
----------------------------------------------------------------------------
-
--- GENERIC LIBRARY FUNCTIONS
+-- enumFromTo :: Int -> Int -> [Int]
+on enumFromTo(m, n)
+    if m > n then
+        set d to -1
+    else
+        set d to 1
+    end if
+    set lst to {}
+    repeat with i from m to n by d
+        set end of lst to i
+    end repeat
+    return lst
+end enumFromTo
 
 -- filter :: (a -> Bool) -> [a] -> [a]
 on filter(f, xs)
@@ -88,7 +100,7 @@ on filter(f, xs)
         set lng to length of xs
         repeat with i from 1 to lng
             set v to item i of xs
-            if lambda(v, i, xs) then set end of lst to v
+            if |λ|(v, i, xs) then set end of lst to v
         end repeat
         return lst
     end tell
@@ -100,7 +112,7 @@ on foldl(f, startValue, xs)
         set v to startValue
         set lng to length of xs
         repeat with i from 1 to lng
-            set v to lambda(v, item i of xs, i, xs)
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
@@ -112,26 +124,12 @@ on map(f, xs)
         set lng to length of xs
         set lst to {}
         repeat with i from 1 to lng
-            set end of lst to lambda(item i of xs, i, xs)
+            set end of lst to |λ|(item i of xs, i, xs)
         end repeat
         return lst
     end tell
 end map
 
--- range :: Int -> Int -> [Int]
-on range(m, n)
-    if n < m then
-        set d to -1
-    else
-        set d to 1
-    end if
-    set lst to {}
-    repeat with i from m to n by d
-        set end of lst to i
-    end repeat
-    return lst
-end range
-
 -- Lift 2nd class handler function into 1st class script wrapper
 -- mReturn :: Handler -> Script
 on mReturn(f)
@@ -139,7 +137,7 @@ on mReturn(f)
         f
     else
         script
-            property lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn

Task/Amicable-pairs/Elena/amicable-pairs.elena

@@ -0,0 +1,32 @@
+import extensions.
+import system'routines.
+import system'math.
+
+const int Limit = 20000.
+
+extension op
+{
+    properDivisors
+        = Range new(1,self / 2); filterBy(:n)(self mod:n == 0).
+
+    amicablePairs
+    [
+        var divsums := Range new(0, self); selectBy(:i)(i properDivisors; summarize(Integer new)); toArray.
+
+        ^ 1 repeatTill(divsums length);
+            filterBy(:i)
+            [
+                var sum := divsums[i].
+                ^ (i < sum) && (sum < divsums length) && (divsums[sum] == i)
+            ];
+            selectBy(:i)({ item1 = i. item2 = divsums[i]. }).
+    ]
+}
+
+public program =
+[
+    Limit amicablePairs; forEach(:pair)
+    [
+        console printLine(pair item1, " ", pair item2).
+    ]
+].

Task/Amicable-pairs/Factor/amicable-pairs.factor

@@ -0,0 +1,16 @@
+USING: grouping math.primes.factors math.ranges ;
+
+: pdivs      ( n -- seq )   divisors but-last ;
+: dsum       ( n -- sum )   pdivs sum ;
+: dsum=      ( n m -- ? )   dsum = ;
+: both-dsum= ( n m -- ? )   [ dsum= ] [ swap dsum= ] 2bi and ;
+: amicable?  ( n m -- ? )   [ both-dsum= ] [ = not ] 2bi and ;
+: drange     ( -- seq )     2 20000 [a,b) ;
+: dsums      ( -- seq )     drange [ dsum ] map ;
+: is-am?-seq ( -- seq )     dsums drange [ amicable? ] 2map ;
+: am-nums    ( -- seq )     t is-am?-seq indices ;
+: am-nums-c  ( -- seq )     am-nums [ 2 + ] map ;
+: am-pairs   ( -- seq )     am-nums-c 2 group ;
+: print-am   ( -- )         am-pairs [ >array . ] each ;
+
+print-am

Task/Amicable-pairs/Julia/amicable-pairs-2.julia

@@ -1,3 +1,5 @@
+using Primes
+
 const L = 2*10^4
 acnt = 0
 

Task/Amicable-pairs/Oforth/amicable-pairs.oforth

@@ -1,10 +1,14 @@
-Integer method: properDivs  self 2 / seq filter(#[ self swap mod 0 == ]) ;
+import: mapping
+
+Integer method: properDivs -- []
+   #[ self swap mod 0 == ] self 2 / seq filter ;
 
 : amicables
 | i j |
-   ListBuffer new
+   Array new
    20000 loop: i [
-      i properDivs sum dup ->j i <= ifTrue: [ continue ]
-      j properDivs sum i <> ifTrue: [ continue ]
+      i properDivs sum dup ->j i <= if continue then
+      j properDivs sum i <> if continue then
       [ i, j ] over add
-      ] ;
+      ]
+;

Task/Amicable-pairs/R/amicable-pairs.r

@@ -0,0 +1,11 @@
+divisors <- function (n) {
+  Filter( function (m) 0 == n %% m, 1:(n/2) )
+}
+
+table = sapply(1:19999, function (n) sum(divisors(n)) )
+
+for (n in 1:19999) {
+  m = table[n]
+  if ((m > n) && (m < 20000) && (n == table[m]))
+    cat(n, " ", m, "\n")
+}

Task/Amicable-pairs/VBA/amicable-pairs.vba

@@ -0,0 +1,38 @@
+Option Explicit
+
+Public Sub AmicablePairs()
+Dim a(2 To 20000) As Long, c As New Collection, i As Long, j As Long, t#
+    t = Timer
+    For i = LBound(a) To UBound(a)
+        'collect the sum of the proper divisors
+        'of each numbers between 2 and 20000
+        a(i) = S(i)
+    Next
+    'Double Loops to test the amicable
+    For i = LBound(a) To UBound(a)
+        For j = i + 1 To UBound(a)
+            If i = a(j) Then
+                If a(i) = j Then
+                     On Error Resume Next
+                     c.Add i & " : " & j, CStr(i * j)
+                     On Error GoTo 0
+                     Exit For
+                End If
+            End If
+        Next
+    Next
+    'End. Return :
+    Debug.Print "Execution Time : " & Timer - t & " seconds."
+    Debug.Print "Amicable pairs below 20 000 are : "
+    For i = 1 To c.Count
+        Debug.Print c.Item(i)
+    Next i
+End Sub
+
+Private Function S(n As Long) As Long
+'returns the sum of the proper divisors of n
+Dim j As Long
+    For j = 1 To n \ 2
+        If n Mod j = 0 Then S = j + S
+    Next
+End Function