Amicable pairs: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|Racket}}: now uses proper-divisors.rkt)
Line 155: Line 155:
12285 14595
12285 14595
17296 18416
17296 18416
</pre>

=={{header|Pascal}}==
<lang pascal>program AmicablePairs;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON}
{$OPTIMIZATION PeepHole}
{$OPTIMIZATION CSE}
{$OPTIMIZATION ASMCSE}
{$CODEALIGN loop=8,proc=32}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
sysutils;
const
MAX = 20000;
// MAX = 11791935;//4*MAX Byte
var
power: array[0..31] of LongInt;
PowerFac : array[0..31] of LongWord;
DivSumField : array[0..MAX] of LongWord;
Procedure CalcPotfactor(p:NativeInt);
var
i: NativeInt;
Pot,probe : Int64;
begin
Pot := p;
Probe := 1;
For i := 0 to High(PowerFac) do
begin
Probe := Probe+Pot;
IF (POT > MAX){ OR (Probe > High(PowerFac[0]))} then
BREAK;
PowerFac[i] := Probe;
Pot := Pot*p;
end;
end;
procedure Init;
// Init DivSumField to 1 and divsum of powers of 2
// Only a small improvement (22 <-> 21.5 secs for MAX = 500'000'000 )
var
pot,Len : Integer;
Begin
DivSumField[0]:= 0;
len := 2;
pot := 0;
CalcPotfactor(2);
DivSumField[1]:= 1;
DivSumField[2]:= PowerFac[Pot];
while 2*len<= MAX do
begin
move(DivSumField[1],DivSumField[len+1],len*SizeOf(DivSumField[0]));
len := len*2;
inc(pot);
DivSumField[len]:= PowerFac[Pot];
end;

move(DivSumField[1],DivSumField[len+1],(MAX-len)*SizeOf(DivSumField[0]));
end;
procedure ProperDivs(n: LongWord);
var
su,so : string;
i,q : LongWord;
begin
su:= '1';
so:= '';
i := 2;
while i*i <= n do
begin
q := n div i;
IF q*i -n = 0 then
begin
su:= su+','+IntToStr(i);
IF q <> i then
so:= ','+IntToStr(q)+so;
end;
inc(i);
end;
writeln(' [',su+so,']');
end;

procedure Check;
var
i,s,n : NativeInt;
begin
n := 0;
For i := 2 to MAX do
begin
s := DivSumField[i]-i;
// Damit s nie > MAX
IF i > s then
begin
try
IF DivSumField[s]= DivSumField[i] then
begin
inc(n);
writeln(s:10,i:10);
ProperDivs(s);
ProperDivs(i);
writeln;
end;
except
writeln('Fehler ',i:10,s:10);
end;
end;
end;
writeln(n,' amicable numbers upto ',MAX);
end;

function NextPotCnt(p: NativeInt):NativeInt;
//return the powest <> 0
var
i : NativeInt;
begin
result := 0;
repeat
i := power[result];
Inc(i);
IF i < p then
BREAK
else
begin
i := 0;
power[result] := 0;
inc(result);
end;
until false;
power[result] := i;
end;

var
T1,T0: TDatetime;
prim,
actNumber,p1 : NativeInt;

begin
T0:= time;
DivSumField[0]:= 0;For prim := 1 to MAX do DivSumField[prim]:= 1; prim:= 2;
//Init; prim := 3;
//small primes
while prim*prim <= MAX do
begin
fillchar(power,SizeOf(power),#0);
CalcPotfactor(prim);
actNumber := 0;
repeat
//actNumber = actual number = n*prim
inc(actNumber,prim);
IF actNumber > MAX then
BREAK;
DivSumField[actNumber] := DivSumField[actNumber]*PowerFac[NextPotCnt(prim)];
until false ;
repeat
inc(prim);
until (DivSumField[prim] = 1);
end;
// no need do calculate PowerFac
IF (DivSumField[prim] <> 1) then
repeat
inc(prim);
until (DivSumField[prim] = 1) OR (prim > MAX);
while prim <= MAX do
begin
actNumber := 0;
p1 := prim+1;
repeat
inc(actNumber,prim);
IF actNumber > MAX then
BREAK;
DivSumField[actNumber] := DivSumField[actNumber]*p1
until false ;
repeat
inc(prim);
until (prim > MAX) OR (DivSumField[prim] = 1);
end;

T1:= time;
Check;
writeln(FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));
end.</lang>
output
<pre>
220 284
[1,2,4,5,10,11,20,22,44,55,110]
[1,2,4,71,142]

1184 1210
[1,2,4,8,16,32,37,74,148,296,592]
[1,2,5,10,11,22,55,110,121,242,605]

2620 2924
[1,2,4,5,10,20,131,262,524,655,1310]
[1,2,4,17,34,43,68,86,172,731,1462]

5020 5564
[1,2,4,5,10,20,251,502,1004,1255,2510]
[1,2,4,13,26,52,107,214,428,1391,2782]

6232 6368
[1,2,4,8,19,38,41,76,82,152,164,328,779,1558,3116]
[1,2,4,8,16,32,199,398,796,1592,3184]

10744 10856
[1,2,4,8,17,34,68,79,136,158,316,632,1343,2686,5372]
[1,2,4,8,23,46,59,92,118,184,236,472,1357,2714,5428]

12285 14595
[1,3,5,7,9,13,15,21,27,35,39,45,63,65,91,105,117,135,189,195,273,315,351,455,585,819,945,1365,1755,2457,4095]
[1,3,5,7,15,21,35,105,139,417,695,973,2085,2919,4865]

17296 18416
[1,2,4,8,16,23,46,47,92,94,184,188,368,376,752,1081,2162,4324,8648]
[1,2,4,8,16,1151,2302,4604,9208]

8 amicable numbers upto 20000
00:00:00.000
</pre>
</pre>



Revision as of 07:50, 29 December 2014

Task
Amicable pairs
You are encouraged to solve this task according to the task description, using any language you may know.

Two integers and are said to be amicable pairs if and the sum of the proper divisors of () as well as .

For example 1184 and 1210 are an amicable pair (with proper divisors 1, 2, 4, 8, 16, 32, 37, 74, 148, 296, 592 and 1, 2, 5, 10, 11, 22, 55, 110, 121, 242, 605 respectively).

Task

Calculate and show here the Amicable pairs below 20,000; (there are eight).

Cf.

AutoHotkey

<lang d>SetBatchLines -1 Loop, 20000 { m := A_index

; Getting factors loop % floor(sqrt(m)) { if ( mod(m, A_index) = 0 ) { if ( A_index ** 2 == m ) { sum += A_index continue } else if ( A_index != 1 ) { sum += A_index + m//A_index } else if ( A_index = 1 ) { sum += A_index } } } ; Factors obtained

; Checking factors of sum if ( sum > 1 ) { loop % floor(sqrt(sum)) { if ( mod(sum, A_index) = 0 ) { if ( A_index ** 2 == sum ) { sum2 += A_index continue } else if ( A_index != 1 ) { sum2 += A_index + sum//A_index } else if ( A_index = 1 ) { sum2 += A_index } } } if ( m = sum2 ) && ( m != sum ) && ( m < sum ) final .= m . ":" . sum . "`n" } ; Checked

sum := 0 sum2 := 0 } MsgBox % final ExitApp</lang>

Output:
220:284
1184:1210
2620:2924
5020:5564
6232:6368
10744:10856
12285:14595
17296:18416

D

Translation of: Python

<lang d>void main() /*@safe @nogc*/ {

   import std.stdio, std.algorithm, std.range, std.typecons, std.array;
   immutable properDivs = (in uint n) pure nothrow @safe /*@nogc*/ =>
       iota(1, (n + 1) / 2 + 1).filter!(x => n % x == 0);
   enum rangeMax = 20_000;
   auto n2d = iota(1, rangeMax + 1).map!(n => properDivs(n).sum);
   foreach (immutable n, immutable divSum; n2d.enumerate(1))
       if (n < divSum && divSum <= rangeMax && n2d[divSum - 1] == n)
           writefln("Amicable pair: %d and %d with proper divisors:\n    %s\n    %s",
                    n, divSum, properDivs(n), properDivs(divSum));

}</lang>

Output:
Amicable pair: 220 and 284 with proper divisors:
    [1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110]
    [1, 2, 4, 71, 142]
Amicable pair: 1184 and 1210 with proper divisors:
    [1, 2, 4, 8, 16, 32, 37, 74, 148, 296, 592]
    [1, 2, 5, 10, 11, 22, 55, 110, 121, 242, 605]
Amicable pair: 2620 and 2924 with proper divisors:
    [1, 2, 4, 5, 10, 20, 131, 262, 524, 655, 1310]
    [1, 2, 4, 17, 34, 43, 68, 86, 172, 731, 1462]
Amicable pair: 5020 and 5564 with proper divisors:
    [1, 2, 4, 5, 10, 20, 251, 502, 1004, 1255, 2510]
    [1, 2, 4, 13, 26, 52, 107, 214, 428, 1391, 2782]
Amicable pair: 6232 and 6368 with proper divisors:
    [1, 2, 4, 8, 19, 38, 41, 76, 82, 152, 164, 328, 779, 1558, 3116]
    [1, 2, 4, 8, 16, 32, 199, 398, 796, 1592, 3184]
Amicable pair: 10744 and 10856 with proper divisors:
    [1, 2, 4, 8, 17, 34, 68, 79, 136, 158, 316, 632, 1343, 2686, 5372]
    [1, 2, 4, 8, 23, 46, 59, 92, 118, 184, 236, 472, 1357, 2714, 5428]
Amicable pair: 12285 and 14595 with proper divisors:
    [1, 3, 5, 7, 9, 13, 15, 21, 27, 35, 39, 45, 63, 65, 91, 105, 117, 135, 189, 195, 273, 315, 351, 455, 585, 819, 945, 1365, 1755, 2457, 4095]
    [1, 3, 5, 7, 15, 21, 35, 105, 139, 417, 695, 973, 2085, 2919, 4865]
Amicable pair: 17296 and 18416 with proper divisors:
    [1, 2, 4, 8, 16, 23, 46, 47, 92, 94, 184, 188, 368, 376, 752, 1081, 2162, 4324, 8648]
    [1, 2, 4, 8, 16, 1151, 2302, 4604, 9208]

J

Proper Divisor implementation:

<lang J>factors=: [: /:~@, */&>@{@((^ i.@>:)&.>/)@q:~&__ properDivisors=: factors -. -.&1</lang>

Amicable pairs:

<lang J> 1+0 20000 #:I.,(</~@i.@#*(*|:))(=/ +/@properDivisors@>) 1+i.20000

 220   284
1184  1210
2620  2924
5020  5564
6232  6368

10744 10856 12285 14595 17296 18416</lang>

Mathematica / Wolfram Language

<lang Mathematica>amicableQ[n_] :=

Module[{sum = Total[Most@Divisors@n]},
 sum != n && n == Total[Most@Divisors@sum]]

Grid@Partition[Cases[Range[4, 20000], _?(amicableQ@# &)], 2]</lang>

Output:

220 284 1184 1210 2620 2924 5020 5564 6232 6368 10744 10856 12285 14595 17296 18416

Pascal

<lang pascal>program AmicablePairs; {$IFDEF FPC}

  {$MODE DELPHI}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION PeepHole}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
  {$CODEALIGN loop=8,proc=32}

{$ELSE}

 {$APPTYPE CONSOLE}

{$ENDIF}

uses

 sysutils;

const

 MAX = 20000;

// MAX = 11791935;//4*MAX Byte var

 power: array[0..31] of LongInt;
 PowerFac : array[0..31] of LongWord;
 DivSumField : array[0..MAX] of LongWord;
 

Procedure CalcPotfactor(p:NativeInt); var

 i: NativeInt;
 Pot,probe : Int64;

begin

 Pot := p;
 Probe := 1;
 For i := 0 to High(PowerFac) do
 begin
   Probe := Probe+Pot;
   IF (POT > MAX){ OR (Probe > High(PowerFac[0]))} then
     BREAK;
   PowerFac[i] := Probe;
   Pot := Pot*p;
 end;

end;

procedure Init; // Init DivSumField to 1 and divsum of powers of 2 // Only a small improvement (22 <-> 21.5 secs for MAX = 500'000'000 ) var

 pot,Len : Integer;

Begin

 DivSumField[0]:= 0;
 len := 2;
 pot := 0;
 CalcPotfactor(2);
 DivSumField[1]:= 1;
 DivSumField[2]:= PowerFac[Pot];  
 
 while 2*len<= MAX do 
 begin
   move(DivSumField[1],DivSumField[len+1],len*SizeOf(DivSumField[0]));
   len := len*2;
   inc(pot);
   DivSumField[len]:= PowerFac[Pot];
 end;  
 move(DivSumField[1],DivSumField[len+1],(MAX-len)*SizeOf(DivSumField[0]));

end;

procedure ProperDivs(n: LongWord); var

 su,so : string;
 i,q : LongWord;

begin

 su:= '1';
 so:= ;
 i := 2;
 while i*i <= n do
 begin
   q := n div i;
   IF q*i -n = 0 then
   begin
     su:= su+','+IntToStr(i);
     IF q <> i then
       so:= ','+IntToStr(q)+so;
   end;
   inc(i);    
 end;  
 writeln('  [',su+so,']');      

end;

procedure Check; var

 i,s,n : NativeInt;

begin

 n := 0;
 For i := 2 to MAX do
 begin
   s := DivSumField[i]-i;
   // Damit s nie > MAX
   IF i > s then
   begin
   try
     IF DivSumField[s]= DivSumField[i] then
     begin
       inc(n);
       writeln(s:10,i:10);
       ProperDivs(s);
       ProperDivs(i);
       writeln;
     end;
   except
     writeln('Fehler ',i:10,s:10);
   end;
   end;
 end;
 writeln(n,' amicable numbers upto ',MAX);

end;

function NextPotCnt(p: NativeInt):NativeInt; //return the powest <> 0 var

 i : NativeInt;

begin

 result := 0;
 repeat
   i := power[result];
   Inc(i);
   IF i < p then
     BREAK
   else
   begin
     i := 0;
     power[result] := 0;
     inc(result);
   end;
 until false;
 power[result] := i;

end;

var

 T1,T0: TDatetime;
 prim,
 actNumber,p1 : NativeInt;

begin

 T0:= time;
 DivSumField[0]:= 0;For prim := 1 to MAX do DivSumField[prim]:= 1; prim:= 2; 
 //Init; prim := 3;
 //small primes
 while prim*prim <= MAX do
 begin
   fillchar(power,SizeOf(power),#0);
   CalcPotfactor(prim);
   actNumber := 0;
   repeat
     //actNumber = actual number = n*prim
     inc(actNumber,prim);
     IF actNumber > MAX then
       BREAK;
     DivSumField[actNumber] := DivSumField[actNumber]*PowerFac[NextPotCnt(prim)];
   until false ;
   repeat
     inc(prim);
   until (DivSumField[prim] = 1);
 end;
 

// no need do calculate PowerFac

 IF (DivSumField[prim] <> 1) then
   repeat
     inc(prim);
   until (DivSumField[prim] = 1) OR (prim > MAX);
   
 while prim <= MAX do
 begin
   actNumber := 0;
   p1 := prim+1;
   repeat
     inc(actNumber,prim);
     IF actNumber > MAX then
       BREAK;
     DivSumField[actNumber] := DivSumField[actNumber]*p1
   until false ;
   
   repeat
     inc(prim);
   until (prim > MAX) OR (DivSumField[prim] = 1);
 end;
 T1:= time;
 Check;
 writeln(FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));

end.</lang> output

       220       284
  [1,2,4,5,10,11,20,22,44,55,110]
  [1,2,4,71,142]

      1184      1210
  [1,2,4,8,16,32,37,74,148,296,592]
  [1,2,5,10,11,22,55,110,121,242,605]

      2620      2924
  [1,2,4,5,10,20,131,262,524,655,1310]
  [1,2,4,17,34,43,68,86,172,731,1462]

      5020      5564
  [1,2,4,5,10,20,251,502,1004,1255,2510]
  [1,2,4,13,26,52,107,214,428,1391,2782]

      6232      6368
  [1,2,4,8,19,38,41,76,82,152,164,328,779,1558,3116]
  [1,2,4,8,16,32,199,398,796,1592,3184]

     10744     10856
  [1,2,4,8,17,34,68,79,136,158,316,632,1343,2686,5372]
  [1,2,4,8,23,46,59,92,118,184,236,472,1357,2714,5428]

     12285     14595
  [1,3,5,7,9,13,15,21,27,35,39,45,63,65,91,105,117,135,189,195,273,315,351,455,585,819,945,1365,1755,2457,4095]
  [1,3,5,7,15,21,35,105,139,417,695,973,2085,2919,4865]

     17296     18416
  [1,2,4,8,16,23,46,47,92,94,184,188,368,376,752,1081,2162,4324,8648]
  [1,2,4,8,16,1151,2302,4604,9208]

8 amicable numbers upto 20000
00:00:00.000

PL/I

Translation of: REXX

<lang pli>*process source xref;

ami: Proc Options(main);
p9a=time();
Dcl (p9a,p9b,p9c) Pic'(9)9';
Dcl sumpd(20000) Bin Fixed(31);
Dcl pd(300) Bin Fixed(31);
Dcl npd     Bin Fixed(31);
Dcl (x,y)   Bin Fixed(31);
Do x=1 To 20000;
  Call proper_divisors(x,pd,npd);
  sumpd(x)=sum(pd,npd);
  End;
p9b=time();
Put Edit('sum(pd) computed in',(p9b-p9a)/1000,' seconds elapsed')
        (Skip,col(7),a,f(6,3),a);
Do x=1 To 20000;
  Do y=x+1 To 20000;
    If y=sumpd(x) &
       x=sumpd(y) Then
      Put Edit(x,y,' found after ',elapsed(),' seconds')
              (Skip,2(f(6)),a,f(6,3),a);
    End;
  End;
Put Edit(elapsed(),' seconds total search time')(Skip,f(6,3),a);
proper_divisors: Proc(n,pd,npd);
Dcl (n,pd(300),npd) Bin Fixed(31);
Dcl (d,delta)       Bin Fixed(31);
npd=0;
If n>1 Then Do;
  If mod(n,2)=1 Then  /* odd number  */
    delta=2;
  Else                /* even number */
    delta=1;
  Do d=1 To n/2 By delta;
    If mod(n,d)=0 Then Do;
      npd+=1;
      pd(npd)=d;
      End;
    End;
  End;
End;
sum: Proc(pd,npd) Returns(Bin Fixed(31));
Dcl (pd(300),npd) Bin Fixed(31);
Dcl sum Bin Fixed(31) Init(0);
Dcl i   Bin Fixed(31);
Do i=1 To npd;
  sum+=pd(i);
  End;
Return(sum);
End;
elapsed: Proc Returns(Dec Fixed(6,3));
p9c=time();
Return((p9c-p9b)/1000);
End;
End;</lang>
Output:
      sum(pd) computed in 0.510 seconds elapsed
   220   284 found after  0.010 seconds
  1184  1210 found after  0.060 seconds
  2620  2924 found after  0.110 seconds
  5020  5564 found after  0.210 seconds
  6232  6368 found after  0.260 seconds
 10744 10856 found after  2.110 seconds
 12285 14595 found after  2.150 seconds
 17296 18416 found after  2.240 seconds
 2.250 seconds total search time

Python

Importing Proper divisors from prime factors: <lang python>from proper_divisors import proper_divs

def amicable(rangemax=20000):

   n2divsum = {n: sum(proper_divs(n)) for n in range(1, rangemax + 1)}
   for num, divsum in n2divsum.items():
       if num < divsum and divsum <= rangemax and n2divsum[divsum] == num:
           yield num, divsum

if __name__ == '__main__':

   for num, divsum in amicable():
       print('Amicable pair: %i and %i With proper divisors:\n    %r\n    %r'
             % (num, divsum, sorted(proper_divs(num)), sorted(proper_divs(divsum))))</lang>
Output:
Amicable pair: 220 and 284 With proper divisors:
    [1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110]
    [1, 2, 4, 71, 142]
Amicable pair: 1184 and 1210 With proper divisors:
    [1, 2, 4, 8, 16, 32, 37, 74, 148, 296, 592]
    [1, 2, 5, 10, 11, 22, 55, 110, 121, 242, 605]
Amicable pair: 2620 and 2924 With proper divisors:
    [1, 2, 4, 5, 10, 20, 131, 262, 524, 655, 1310]
    [1, 2, 4, 17, 34, 43, 68, 86, 172, 731, 1462]
Amicable pair: 5020 and 5564 With proper divisors:
    [1, 2, 4, 5, 10, 20, 251, 502, 1004, 1255, 2510]
    [1, 2, 4, 13, 26, 52, 107, 214, 428, 1391, 2782]
Amicable pair: 6232 and 6368 With proper divisors:
    [1, 2, 4, 8, 19, 38, 41, 76, 82, 152, 164, 328, 779, 1558, 3116]
    [1, 2, 4, 8, 16, 32, 199, 398, 796, 1592, 3184]
Amicable pair: 10744 and 10856 With proper divisors:
    [1, 2, 4, 8, 17, 34, 68, 79, 136, 158, 316, 632, 1343, 2686, 5372]
    [1, 2, 4, 8, 23, 46, 59, 92, 118, 184, 236, 472, 1357, 2714, 5428]
Amicable pair: 12285 and 14595 With proper divisors:
    [1, 3, 5, 7, 9, 13, 15, 21, 27, 35, 39, 45, 63, 65, 91, 105, 117, 135, 189, 195, 273, 315, 351, 455, 585, 819, 945, 1365, 1755, 2457, 4095]
    [1, 3, 5, 7, 15, 21, 35, 105, 139, 417, 695, 973, 2085, 2919, 4865]
Amicable pair: 17296 and 18416 With proper divisors:
    [1, 2, 4, 8, 16, 23, 46, 47, 92, 94, 184, 188, 368, 376, 752, 1081, 2162, 4324, 8648]
    [1, 2, 4, 8, 16, 1151, 2302, 4604, 9208]

Racket

With Proper_divisors#Racket in place: <lang racket>#lang racket (require "proper-divisors.rkt") (define SCOPE 20000)

(define P

 (let ((P-v (vector)))
   (λ (n)
     (set! P-v (fold-divisors P-v n 0 +))
     (vector-ref P-v n))))
returns #f if not an amicable number, amicable pairing otherwise

(define (amicable? n)

 (define m (P n))
 (define m-sod (P m))
 (and (= m-sod n)
      (< m n) ; each pair exactly once, also eliminates perfect numbers
      m))

(void (amicable? SCOPE)) ; prime the memoisation

(for* ((n (in-range 1 (add1 SCOPE)))

      (m (in-value (amicable? n)))
      #:when m)
 (printf #<<EOS

amicable pair: ~a, ~a

 ~a: divisors: ~a
 ~a: divisors: ~a


EOS

         n m n (proper-divisors n)  m (proper-divisors m)))

</lang>

Output:
amicable pair: 284, 220
  284: divisors: (1 2 4 71 142)
  220: divisors: (1 2 4 5 10 11 20 22 44 55 110)

amicable pair: 1210, 1184
  1210: divisors: (1 2 5 10 11 22 55 110 121 242 605)
  1184: divisors: (1 2 4 8 16 32 37 74 148 296 592)

amicable pair: 2924, 2620
  2924: divisors: (1 2 4 17 34 43 68 86 172 731 1462)
  2620: divisors: (1 2 4 5 10 20 131 262 524 655 1310)

amicable pair: 5564, 5020
  5564: divisors: (1 2 4 13 26 52 107 214 428 1391 2782)
  5020: divisors: (1 2 4 5 10 20 251 502 1004 1255 2510)

amicable pair: 6368, 6232
  6368: divisors: (1 2 4 8 16 32 199 398 796 1592 3184)
  6232: divisors: (1 2 4 8 19 38 41 76 82 152 164 328 779 1558 3116)

amicable pair: 10856, 10744
  10856: divisors: (1 2 4 8 23 46 59 92 118 184 236 472 1357 2714 5428)
  10744: divisors: (1 2 4 8 17 34 68 79 136 158 316 632 1343 2686 5372)

amicable pair: 14595, 12285
  14595: divisors: (1 3 5 7 15 21 35 105 139 417 695 973 2085 2919 4865)
  12285: divisors: (1 3 5 7 9 13 15 21 27 35 39 45 63 65 91 105 117 135 189 195 273 315 351 455 585 819 945 1365 1755 2457 4095)

amicable pair: 18416, 17296
  18416: divisors: (1 2 4 8 16 1151 2302 4604 9208)
  17296: divisors: (1 2 4 8 16 23 46 47 92 94 184 188 368 376 752 1081 2162 4324 8648)

REXX

<lang rexx>Call time 'R' Do x=1 To 20000

 pd=proper_divisors(x)
 sumpd.x=sum(pd)
 End

Say 'sum(pd) computed in' time('E') 'seconds' Call time 'R' Do x=1 To 20000

 /* If x//1000=0 Then Say x time() */
 Do y=x+1 To 20000
   If y=sumpd.x &,
      x=sumpd.y Then
   Say x y 'found after' time('E') 'seconds'
   End
 End

Say time('E') 'seconds total search time' Exit

proper_divisors: Procedure Parse Arg n Pd= If n=1 Then Return If n//2=1 Then /* odd number */

 delta=2

Else /* even number */

 delta=1

Do d=1 To n%2 By delta

 If n//d=0 Then
   pd=pd d
 End

Return space(pd)

sum: Procedure Parse Arg list sum=0 Do i=1 To words(list)

 sum=sum+word(list,i)
 End

Return sum</lang>

Output:
sum(pd) computed in 48.502000 seconds
220 284 found after 3.775000 seconds
1184 1210 found after 21.611000 seconds
2620 2924 found after 46.817000 seconds
5020 5564 found after 84.296000 seconds
6232 6368 found after 100.918000 seconds
10744 10856 found after 150.126000 seconds
12285 14595 found after 162.124000 seconds
17296 18416 found after 185.600000 seconds
188.836000 seconds total search time 

Ruby

With proper_divisors#Ruby in place: <lang ruby>h = {} (1..20_000).each{|n| h[n] = n.proper_divisors.inject(:+)} h.select{|k,v| h[v] == k && k < v}.each do |key,val| # k<v filters out doubles and perfects

 puts "#{key} and #{val}"

end </lang>

Output:

220 and 284 1184 and 1210 2620 and 2924 5020 and 5564 6232 and 6368 10744 and 10856 12285 and 14595 17296 and 18416

Tcl

<lang tcl>proc properDivisors {n} {

   if {$n == 1} return
   set divs 1
   set sum 1
   for {set i 2} {$i*$i <= $n} {incr i} {

if {!($n % $i)} { lappend divs $i incr sum $i if {$i*$i < $n} { lappend divs [set d [expr {$n / $i}]] incr sum $d } }

   }
   return [list $sum $divs]

}

proc amicablePairs {limit} {

   set result {}
   set sums [set divs {{}}]
   for {set n 1} {$n < $limit} {incr n} {

lassign [properDivisors $n] sum d lappend sums $sum lappend divs [lsort -integer $d]

   }
   for {set n 1} {$n < $limit} {incr n} {

set nsum [lindex $sums $n] for {set m 1} {$m < $n} {incr m} { if {$n==[lindex $sums $m] && $m==$nsum} { lappend result $m $n [lindex $divs $m] [lindex $divs $n] } }

   }
   return $result

}

foreach {m n md nd} [amicablePairs 20000] {

   puts "$m and $n are an amicable pair with these proper divisors"
   puts "\t$m : $md"
   puts "\t$n : $nd"

}</lang>

Output:
220 and 284 are an amicable pair with these proper divisors
	220 : 1 2 4 5 10 11 20 22 44 55 110
	284 : 1 2 4 71 142
1184 and 1210 are an amicable pair with these proper divisors
	1184 : 1 2 4 8 16 32 37 74 148 296 592
	1210 : 1 2 5 10 11 22 55 110 121 242 605
2620 and 2924 are an amicable pair with these proper divisors
	2620 : 1 2 4 5 10 20 131 262 524 655 1310
	2924 : 1 2 4 17 34 43 68 86 172 731 1462
5020 and 5564 are an amicable pair with these proper divisors
	5020 : 1 2 4 5 10 20 251 502 1004 1255 2510
	5564 : 1 2 4 13 26 52 107 214 428 1391 2782
6232 and 6368 are an amicable pair with these proper divisors
	6232 : 1 2 4 8 19 38 41 76 82 152 164 328 779 1558 3116
	6368 : 1 2 4 8 16 32 199 398 796 1592 3184
10744 and 10856 are an amicable pair with these proper divisors
	10744 : 1 2 4 8 17 34 68 79 136 158 316 632 1343 2686 5372
	10856 : 1 2 4 8 23 46 59 92 118 184 236 472 1357 2714 5428
12285 and 14595 are an amicable pair with these proper divisors
	12285 : 1 3 5 7 9 13 15 21 27 35 39 45 63 65 91 105 117 135 189 195 273 315 351 455 585 819 945 1365 1755 2457 4095
	14595 : 1 3 5 7 15 21 35 105 139 417 695 973 2085 2919 4865
17296 and 18416 are an amicable pair with these proper divisors
	17296 : 1 2 4 8 16 23 46 47 92 94 184 188 368 376 752 1081 2162 4324 8648
	18416 : 1 2 4 8 16 1151 2302 4604 9208

zkl

Slooooow <lang zkl>fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) } const N=20000; sums:=[1..N].pump(T(-1),fcn(n){ properDivs(n).sum(0) }); [0..].zip(sums).filter('wrap([(n,s)]){ (n<s<=N) and sums[s]==n }).println();</lang>

Output:
L(L(220,284),L(1184,1210),L(2620,2924),L(5020,5564),L(6232,6368),L(10744,10856),L(12285,14595),L(17296,18416))