smooth_generate.pl 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147
  1. #!/usr/bin/perl
  2. use 5.020;
  3. use warnings;
  4. use experimental qw(signatures);
  5. use Math::GMPz;
  6. use ntheory qw(:all);
  7. sub check_valuation ($n, $p) {
  8. #~ if ($p == 2) {
  9. #~ return valuation($n, $p) < 5;
  10. #~ }
  11. #~ if ($p == 3) {
  12. #~ return valuation($n, $p) < 3;
  13. #~ }
  14. #~ if ($p == 7) {
  15. #~ return valuation($n, $p) < 3;
  16. #~ }
  17. ($n % $p) != 0;
  18. }
  19. sub smooth_numbers ($limit, $primes) {
  20. my @h = (1);
  21. foreach my $p (@$primes) {
  22. say "Prime: $p";
  23. foreach my $n (@h) {
  24. if ($n * $p <= $limit and check_valuation($n, $p)) {
  25. push @h, $n * $p;
  26. }
  27. }
  28. }
  29. return \@h;
  30. }
  31. sub arithmetic_derivative {
  32. my ($n) = @_;
  33. my @factors = factor($n);
  34. my $sum = 0;
  35. foreach my $p (@factors) {
  36. $sum += divint($n, $p);
  37. }
  38. return $sum;
  39. }
  40. sub dynamicPreimage ($N, $L) {
  41. my %r = (1 => [1]);
  42. foreach my $l (@$L) {
  43. my %t;
  44. foreach my $pair (@$l) {
  45. my ($x, $y) = @$pair;
  46. foreach my $d (divisors(divint($N, $x))) {
  47. if (exists $r{$d}) {
  48. push @{$t{mulint($x, $d)}}, map { mulint($_, $y) } @{$r{$d}};
  49. }
  50. }
  51. }
  52. while (my ($k, $v) = each %t) {
  53. push @{$r{$k}}, @$v;
  54. }
  55. }
  56. return if not exists $r{$N};
  57. sort { $a <=> $b } @{$r{$N}};
  58. }
  59. sub cook_sigma ($N, $k) {
  60. my %L;
  61. foreach my $d (divisors($N)) {
  62. next if ($d == 1);
  63. foreach my $p (map { $_->[0] } factor_exp(subint($d, 1))) {
  64. my $q = addint(mulint($d, subint(powint($p, $k), 1)), 1);
  65. my $t = valuation($q, $p);
  66. next if ($t <= $k or ($t % $k) or $q != powint($p, $t));
  67. push @{$L{$p}}, [$d, powint($p, subint(divint($t, $k), 1))];
  68. }
  69. }
  70. [values %L];
  71. }
  72. sub inverse_sigma ($N, $k = 1) {
  73. dynamicPreimage($N, cook_sigma($N, $k));
  74. }
  75. sub isok ($n) {
  76. my $d = arithmetic_derivative($n);
  77. foreach my $k (inverse_sigma($n)) {
  78. if ($d == $k) {
  79. return $k;
  80. }
  81. }
  82. return undef;
  83. }
  84. my @smooth_primes;
  85. foreach my $p (@{primes(1000)}) {
  86. if ($p == 2) {
  87. push @smooth_primes, $p;
  88. next;
  89. }
  90. if (is_smooth($p+1, 3)) {
  91. push @smooth_primes, $p;
  92. }
  93. }
  94. my $h = smooth_numbers(1e15, \@smooth_primes);
  95. say "\nFound: ", scalar(@$h), " terms\n";
  96. my %table;
  97. foreach my $n (@$h) {
  98. if (defined(my $k = isok($n))) {
  99. say "Found: $k -> ", join(' * ', map { "$_->[0]^$_->[1]" } factor_exp($k));
  100. }
  101. }