recursivley_generate_carmichael.pl 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. #!/usr/bin/perl
  2. # Author: Daniel "Trizen" Șuteu
  3. # Date: 10 August 2020
  4. # https://github.com/trizen
  5. # Recursively generate Carmichael numbers from a given input numbers, using its lambda value.
  6. use 5.020;
  7. use warnings;
  8. use Math::GMPz;
  9. use Math::AnyNum qw(is_smooth is_rough smooth_part rough_part);
  10. use ntheory qw(mulmod divisor_sum divisors forcomb is_prime factor);
  11. use Math::Prime::Util::GMP qw(gcd totient carmichael_lambda mulint divint vecprod modint binomial);
  12. use experimental qw(signatures);
  13. sub is_cyclic ($n) {
  14. gcd(totient($n), $n) == 1;
  15. }
  16. sub lambda_primes ($L, $n) {
  17. grep {
  18. ($_ > 2)
  19. and (($L % $_) != 0)
  20. and is_prime($_)
  21. and gcd($n, $_) == 1
  22. and is_cyclic(mulint($n, $_))
  23. }
  24. map { ($_ >= ~0) ? (Math::GMPz->new($_) + 1) : ($_ + 1) } divisors($L);
  25. }
  26. sub generate($n) {
  27. is_cyclic($n) || return;
  28. #~ if ($n >= ~0 and ref($n) ne 'Math::GMPz') {
  29. #~ $n = Math::GMPz->new("$n");
  30. #~ }
  31. my $L = carmichael_lambda($n);
  32. #~ if ($L >= ~0) {
  33. #~ $L = Math::GMPz->new($L);
  34. #~ }
  35. if (divisor_sum($L, 0) > 2**17) { # too many divisors
  36. return;
  37. }
  38. my @P = lambda_primes($L, $n);
  39. my $r = modint($n, $L);
  40. my @arr;
  41. foreach my $p (@P) {
  42. if (mulmod($p, $r, $L) == 1) {
  43. push @arr, mulint($n, $p);
  44. say $arr[-1];
  45. }
  46. }
  47. foreach my $k (3) {
  48. if (binomial(scalar(@P), $k) < 1e6) {
  49. forcomb {
  50. my $z = vecprod(@P[@_]);
  51. if (mulmod($r, $z, $L) == 1) {
  52. push @arr, mulint($n, $z);
  53. say $arr[-1];
  54. }
  55. } scalar(@P), $k;
  56. }
  57. }
  58. foreach my $k (@arr) {
  59. generate($k);
  60. }
  61. }
  62. use Memoize qw(memoize);
  63. memoize('generate');
  64. #<<<
  65. #~ foreach my $k(1e6..1e7) {
  66. #~ is_cyclic($k) || next;
  67. #~ generate($k);
  68. #~ }
  69. #>>>
  70. #~ __END__
  71. while (<>) {
  72. my $n = (split(' ', $_))[-1];
  73. $n || next;
  74. $n =~ /^[0-9]+\z/ || next;
  75. #is_smooth($n, 1e7) || next;
  76. is_rough($n, 1e7) && next;
  77. if (length($n) > 40) {
  78. is_smooth($n, 1e7) || next;
  79. }
  80. #~ my @f = factor($n);
  81. #~ next if scalar(@f) > 20;
  82. #~ foreach my $k (1..3) {
  83. #~ forcomb {
  84. #~ generate(divint($n, vecprod(@f[@_])));
  85. #~ } scalar(@f), $k;
  86. #~ }
  87. #~ foreach my $k(2..1e5) {
  88. #~ modint($n,$k) == 0 or next;
  89. #~ generate(divint($n,$k));
  90. #~ }
  91. #my $s = smooth_part($n, 1e3);
  92. #~ my $s = rough_part($n, 1e4);
  93. #~ divisor_sum($s, 0) <= 2**10 or next;
  94. #~ foreach my $k (divisors($s)) {
  95. #~ $k > 1 or next;
  96. #~ generate(divint($n,$k));
  97. #~ }
  98. generate($n);
  99. }