recursivley_generate_lucas_psp.pl 3.3 KB

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