my $fr=219;
my @wp;
while ($fr <= 10000)
{
  my $i=0;my $m=$fr-1;
  for (1..$m)
  {
    $i+= $_ unless ($fr % $_) ;
  }
  my $k=0;$m=$i-1;
  for (1..$m)
  {
    $k+= $_ unless ($i % $_) ;
  }
  if ($k==$fr)
  {
	 push @wp, [$fr,$i];
    print "*";
  }
$fr++;
}

print "\n";
for (@wp)
{
	print "@$_\n";
}
print "\n";