$| = 1; my $max = 3**13; my @sieve = (); foreach my $n (2..$max) { if (not $sieve[$n]) { my $m = $n; while ($m <= $max) { $sieve[$m] = $n; $m += $n; } } } sub primesignature { my $n = shift; my @primesignature = (); while ($n>1) { my $prime = $sieve[$n]; my $power = 0; while ($n % $prime==0) { $n /= $prime; $power++; } push @primesignature => $power; } return join("," => sort { $a <=> $b } @primesignature); } my @primesignature = (); foreach my $n (1..$max) { $primesignature[$n] = primesignature($n); } my @seen = (); sub a { my $n = shift; my $a = 1; while ($a==$n || $seen[$a] || $primesignature[$a] ne $primesignature[$n]) { $a++; exit if $a>$max; } $seen[$a]++; return $a; } print "1 1\n"; $seen[1]++; foreach my $n (2..10_000) { my $a = a($n); print "$n $a\n"; }