Data update

Task/Amicable-pairs/ALGOL-60/amicable-pairs.alg

@@ -2,7 +2,7 @@ begin
 
 comment - return n mod m;
 integer procedure mod(n, m);
-  value n, q; integer n, m;
+  value n, m; integer n, m;
 begin
   mod := n - m * entier(n / m);
 end;

Task/Amicable-pairs/ALGOL-68/amicable-pairs.alg

@@ -7,11 +7,12 @@ BEGIN # find amicable pairs p1, p2 where each is equal to the other's proper div
         OD
     OD;
     # find the amicable pairs up to 20 000                            #
-    FOR p1 TO UPB pd sum DO
-        FOR p2 FROM p1 + 1 TO UPB pd sum DO
-            IF pd sum[ p1 ] = p2 AND pd sum[ p2 ] = p1 THEN
-                print( ( whole( p1, -6 ), " and ", whole( p2, -6 ), " are an amicable pair", newline ) )
+    FOR p1 TO UPB pd sum - 1 DO
+        INT pd sum p1 = pd sum[ p1 ];
+        IF pd sum p1 > p1 AND pd sum p1 <= UPB pd sum THEN
+            IF pd sum[ pd sum p1 ] = p1 THEN
+                print( ( whole( p1, -6 ), " and ", whole( pd sum p1, -6 ), " are an amicable pair", newline ) )
             FI
-        OD
+        FI
     OD
 END

Task/Amicable-pairs/ALGOL-W/amicable-pairs.alg

@@ -0,0 +1,23 @@
+begin % find amicable pairs p1, p2 where each is equal to the other's      %
+      % proper divisor sum                                                 %
+
+    integer MAX_NUMBER;
+    MAX_NUMBER := 20000;
+
+    begin
+        integer array pdSum( 1 :: MAX_NUMBER ); % table of proper divisors %
+        for i := 1 until MAX_NUMBER do pdSum( i ) := 1;
+        for i := 2 until MAX_NUMBER do begin
+            for j := i + i step i until MAX_NUMBER do pdSum( j ) := pdSum( j ) + i
+        end for_i ;
+
+        % find the amicable pairs up to 20 000                             %
+        for p1 := 1 until MAX_NUMBER - 1 do begin
+            integer pdSumP1;
+            pdSumP1 := pdSum( p1 );
+            if pdSumP1 > p1 and pdSumP1 <= MAX_NUMBER and pdSum( pdSumP1 ) = p1 then begin
+                write( i_w := 5, s_w := 0, p1, " and ", pdSumP1, " are an amicable pair" )
+            end if_pdSumP1_gt_p1_and_le_MAX_NUMBER
+        end for_p1
+    end
+end.

Task/Amicable-pairs/Chipmunk-Basic/amicable-pairs.basic

@@ -0,0 +1,20 @@
+100 cls : rem  10 HOME for Applesoft BASIC
+110 print "The pairs of amicable numbers below 20,000 are :"
+120 print
+130 size = 18500
+140 for n = 1 to size
+150   m = amicable(n)
+160   if m > n and amicable(m) = n then
+170     print using "#####";n;
+180     print " and ";
+190     print using "#####";m
+200   endif
+210 next
+220 end
+230 function amicable(nr)
+240   suma = 1
+250   for d = 2 to sqr(nr)
+260     if nr mod d = 0 then suma = suma+d+nr/d
+270   next
+280   amicable = suma
+290 end function

Task/Amicable-pairs/FutureBasic/amicable-pairs.basic

@@ -0,0 +1,29 @@
+local fn Sigma( n as long ) as long
+  long i, root, sum = 1
+
+  if n == 1 then exit fn = 0
+  root = sqr(n)
+  for i = 2 to root
+    if ( n mod i == 0 ) then sum += i + n/i
+  next
+  if root * root == n then sum -= root
+end fn = sum
+
+void local fn CalculateAmicablePairs( limit as long )
+  long i, m
+
+  printf @"\nAmicable pairs through %ld are:\n", limit
+  for i = 2 to limit
+    m = fn Sigma(i)
+    if ( m > i )
+      if ( fn Sigma(m) == i ) then printf @"%6ld and %ld", i, m
+    end if
+  next
+end fn
+
+CFTimeInterval t
+t = fn CACurrentMediaTime
+fn CalculateAmicablePairs( 20000 )
+printf @"\nCompute time: %.3f ms",(fn CACurrentMediaTime-t)*1000
+
+HandleEvents

Task/Amicable-pairs/Gambas/amicable-pairs.gambas

@@ -0,0 +1,33 @@
+Public sum[19999] As Integer
+
+Public Sub Main()
+
+  Dim n As Integer, f As Integer
+
+  For n = 0 To 19998
+    sum[n] = SumProperDivisors(n)
+  Next
+
+  Print "The pairs of amicable numbers below 20,000 are :\n"
+
+  For n = 0 To 19998
+    ' f = SumProperDivisors(n)
+    f = sum[n]
+    If f <= n Or f < 1 Or f > 19999 Then Continue
+    If f = sum[n] And n = sum[f] Then
+      Print Format$(Str$(n), "#####"); " And "; Format$(Str$(sum[n]), "#####")
+    End If
+  Next
+
+End
+
+Function SumProperDivisors(number As Integer) As Integer
+
+  If number < 2 Then Return 0
+  Dim sum As Integer = 0
+  For i As Integer = 1 To number \ 2
+    If number Mod i = 0 Then sum += i
+  Next
+  Return sum
+
+End Function

Task/Amicable-pairs/Lua/amicable-pairs-2.lua

@@ -0,0 +1,15 @@
+MAX_NUMBER = 20000
+sumDivs = {}    -- table of proper divisors
+for i = 1, MAX_NUMBER do sumDivs[ i ] = 1 end
+for i = 2, MAX_NUMBER do
+    for j = i + i, MAX_NUMBER, i do
+        sumDivs[ j ] = sumDivs[ j ] + i
+    end
+end
+
+for n = 2, MAX_NUMBER do
+    m = sumDivs[n]
+    if m > n then
+        if sumDivs[m] == n then print(n, m) end
+    end
+end

Task/Amicable-pairs/MiniScript/amicable-pairs.mini

@@ -0,0 +1,17 @@
+// find amicable pairs p1, p2 where each is equal to the other's proper divisor sum
+
+MAX_NUMBER = 20000
+pdSum = [1] * ( MAX_NUMBER + 1 )    // table of proper divisors
+for i in range( 2, MAX_NUMBER )
+    for j in range( i + i, MAX_NUMBER, i )
+        pdSum[ j ] += i
+    end for
+end for
+// find the amicable pairs up to 20 000
+ap = []
+for p1 in range( 1, MAX_NUMBER - 1 )
+    pdSumP1 = pdSum[ p1 ]
+    if pdSumP1 > p1 and pdSumP1 <= MAX_NUMBER and pdSum[ pdSumP1 ] == p1 then
+        print str( p1 ) + " and " + str( pdSumP1 ) + " are an amicable pair"
+    end if
+end for

Task/Amicable-pairs/PL-I-80/amicable-pairs-2.pli

@@ -0,0 +1,34 @@
+amicable: procedure options (main);
+
+    %replace
+      search_limit by 20000;
+
+    dcl sumf( 1 : search_limit ) fixed bin;
+    dcl (a, b, found) fixed bin;
+
+    put skip list ('Searching for amicable pairs up to ');
+    put edit (search_limit) (f(5));
+
+    do a = 1 to search_limit; sumf( a ) = 1; end;
+    do a = 2 to search_limit;
+        do b = a + a to search_limit by a;
+            sumf( b ) = sumf( b ) + a;
+        end;
+    end;
+
+    found = 0;
+    do a = 2 to search_limit;
+      b = sumf(a);
+      if (b > a) then
+        do;
+          if (sumf(b) = a) then
+            do;
+              found = found + 1;
+              put skip edit (a,b) (f(7));
+            end;
+        end;
+    end;
+    put skip list (found, ' pairs were found');
+    stop;
+
+end amicable;

Task/Amicable-pairs/PL-M/amicable-pairs.plm

@@ -30,8 +30,9 @@ END;
 
 /* TEST EACH PAIR */
 DO I=2 TO 20$000;
-    DO J=I+1 TO 20$000;
-        IF DIV$SUM(I)=J AND DIV$SUM(J)=I THEN DO;
+    J = DIVSUM(I);
+    IF J > I AND J <= 20$000 THEN DO;
+        IF DIV$SUM(J) = I THEN DO;
             CALL PRINT$NUMBER(I);
             CALL PRINT(.', $');
             CALL PRINT$NUMBER(J);

Task/Amicable-pairs/QBasic/amicable-pairs.basic

@@ -0,0 +1,19 @@
+FUNCTION amicable (nr)
+     suma = 1
+     FOR d = 2 TO SQR(nr)
+	 IF nr MOD d = 0 THEN suma = suma + d + nr / d
+     NEXT
+	 amicable = suma
+END FUNCTION
+
+PRINT "The pairs of amicable numbers below 20,000 are :"
+PRINT
+
+size = 18500
+FOR n = 1 TO size
+    m = amicable(n)
+    IF m > n AND amicable(m) = n THEN
+	PRINT USING "##### and #####"; n; m
+	END IF
+NEXT
+END

Task/Amicable-pairs/True-BASIC/amicable-pairs.basic

@@ -0,0 +1,19 @@
+FUNCTION amicable(nr)
+    LET suma = 1
+    FOR d = 2 TO SQR(nr)
+        IF REMAINDER(nr, d) = 0 THEN
+           LET suma = suma + d + nr / d
+        END IF
+    NEXT d
+    LET amicable = suma
+END FUNCTION
+
+PRINT "The pairs of amicable numbers below 20,000 are :"
+PRINT
+
+LET size = 18500
+FOR n = 1 TO size
+    LET m = amicable(n)
+    IF m > n AND amicable(m) = n THEN PRINT USING "##### and #####": n, m
+NEXT n
+END