cache.pl 67 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556
  1. #!/usr/bin/perl
  2. =begin
  3. This script factorizes a natural number given as a command line
  4. parameter into its prime factors. It first attempts to use trial
  5. division to find very small factors, then uses other special-purpose
  6. factorization methods to find slightly larger factors. If any large
  7. factors remain, it uses the Self-Initializing Quadratic Sieve (SIQS) [2]
  8. to factorize those.
  9. [2] Contini, Scott Patrick. 'Factoring integers with the self-
  10. initializing quadratic sieve.' (1997).
  11. =cut
  12. use 5.020;
  13. use strict;
  14. use warnings;
  15. use Math::GMPz;
  16. use POSIX qw(ULONG_MAX);
  17. use experimental qw(signatures);
  18. use Math::Sidef qw();
  19. use Math::AnyNum qw(is_smooth);
  20. $Sidef::Types::Number::Number::USE_YAFU = 1;
  21. $Sidef::Types::Number::Number::USE_FACTORDB = 0;
  22. $Sidef::Types::Number::Number::VERBOSE = 1;
  23. $Sidef::Types::Number::Number::SPECIAL_FACTORS = 1;
  24. use ntheory qw(
  25. urandomm valuation sqrtmod invmod random_prime factor_exp vecmin vecall
  26. );
  27. use Math::Prime::Util::GMP qw(
  28. is_power powmod vecprod sqrtint rootint logint is_prime trial_factor
  29. gcd sieve_primes consecutive_integer_lcm lucas_sequence is_pseudoprime
  30. );
  31. my $ZERO = Math::GMPz->new(0);
  32. my $ONE = Math::GMPz->new(1);
  33. local $| = 1;
  34. # Tuning parameters
  35. use constant {
  36. FACTOR_MIN_LEN => 25, # factor directly numbers with <= this many digits
  37. PREFACTORIZATION => 0, # try to find very small prime factors of n
  38. FACTORIZE_WITH_SIDEF => 1, # true to factorize large numbers with Math::Sidef
  39. MASK_LIMIT => 200, # show Cn if n > MASK_LIMIT, where n ~ log_10(N)
  40. LOOK_FOR_SMALL_FACTORS => 1,
  41. LOOK_FOR_SPECIAL_FORMS => 0,
  42. SCRAPE_FACTORDB => 0, # factorize with factorDB by scrapping instead of API
  43. MAX_SIZE => 1e4, # ignore numbers with length() greater than this
  44. TRIAL_DIVISION_LIMIT => 1_000_000,
  45. PHI_FINDER_ITERATIONS => 100_000,
  46. FERMAT_ITERATIONS => 100_000,
  47. NEAR_POWER_ITERATIONS => 1_000,
  48. CFRAC_ITERATIONS => 50_000,
  49. HOLF_ITERATIONS => 100_000,
  50. MILLER_RABIN_ITERATIONS => 100,
  51. LUCAS_MILLER_ITERATIONS => 50,
  52. SIQS_TRIAL_DIVISION_EPS => 25,
  53. SIQS_MIN_PRIME_POLYNOMIAL => 400,
  54. SIQS_MAX_PRIME_POLYNOMIAL => 4000,
  55. };
  56. my @small_primes = sieve_primes(2, TRIAL_DIVISION_LIMIT);
  57. package Polynomial {
  58. sub new ($class, $coeff, $A = undef, $B = undef) {
  59. bless {
  60. a => $A,
  61. b => $B,
  62. coeff => $coeff,
  63. }, $class;
  64. }
  65. sub eval ($self, $x) {
  66. my $res = $ZERO;
  67. foreach my $k (@{$self->{coeff}}) {
  68. $res *= $x;
  69. $res += $k;
  70. }
  71. return $res;
  72. }
  73. }
  74. package FactorBasePrime {
  75. sub new ($class, $p, $t, $lp) {
  76. bless {
  77. p => $p,
  78. soln1 => undef,
  79. soln2 => undef,
  80. t => $t,
  81. lp => $lp,
  82. ainv => undef,
  83. }, $class;
  84. }
  85. }
  86. sub siqs_factor_base_primes ($n, $nf) {
  87. my @factor_base;
  88. foreach my $p (@small_primes) {
  89. my $t = sqrtmod($n, $p) // next;
  90. my $lp = sprintf('%0.f', log($p) / log(2));
  91. push @factor_base, FactorBasePrime->new($p, $t, $lp);
  92. if (scalar(@factor_base) >= $nf) {
  93. last;
  94. }
  95. }
  96. return \@factor_base;
  97. }
  98. sub siqs_create_poly ($A, $B, $n, $factor_base, $first) {
  99. my $B_orig = $B;
  100. if (($B << 1) > $A) {
  101. $B = $A - $B;
  102. }
  103. # 0 < $B or die 'error';
  104. # 2 * $B <= $A or die 'error';
  105. # ($B * $B - $n) % $A == 0 or die 'error';
  106. my $g = Polynomial->new([$A * $A, ($A * $B) << 1, $B * $B - $n], $A, $B_orig);
  107. my $h = Polynomial->new([$A, $B]);
  108. foreach my $fb (@$factor_base) {
  109. next if Math::GMPz::Rmpz_divisible_ui_p($A, $fb->{p});
  110. #<<<
  111. $fb->{ainv} = int(invmod($A, $fb->{p})) if $first;
  112. $fb->{soln1} = int(($fb->{ainv} * ( $fb->{t} - $B)) % $fb->{p});
  113. $fb->{soln2} = int(($fb->{ainv} * (-$fb->{t} - $B)) % $fb->{p});
  114. #>>>
  115. }
  116. return ($g, $h);
  117. }
  118. sub siqs_find_first_poly ($n, $m, $factor_base) {
  119. my $p_min_i;
  120. my $p_max_i;
  121. foreach my $i (0 .. $#{$factor_base}) {
  122. my $fb = $factor_base->[$i];
  123. if (not defined($p_min_i) and $fb->{p} >= SIQS_MIN_PRIME_POLYNOMIAL) {
  124. $p_min_i = $i;
  125. }
  126. if (not defined($p_max_i) and $fb->{p} > SIQS_MAX_PRIME_POLYNOMIAL) {
  127. $p_max_i = $i - 1;
  128. last;
  129. }
  130. }
  131. # The following may happen if the factor base is small
  132. if (not defined($p_max_i)) {
  133. $p_max_i = $#{$factor_base};
  134. }
  135. if (not defined($p_min_i)) {
  136. $p_min_i = 5;
  137. }
  138. if ($p_max_i - $p_min_i < 20) {
  139. $p_min_i = vecmin($p_min_i, 5);
  140. }
  141. my $target0 = (log("$n") + log(2)) / 2 - log("$m");
  142. my $target1 = $target0 - log(($factor_base->[$p_min_i]{p} + $factor_base->[$p_max_i]{p}) / 2) / 2;
  143. # find q such that the product of factor_base[q_i] is approximately
  144. # sqrt(2 * n) / m; try a few different sets to find a good one
  145. my ($best_q, $best_a, $best_ratio);
  146. for (1 .. 30) {
  147. my $A = $ONE;
  148. my $log_A = 0;
  149. my %Q;
  150. while ($log_A < $target1) {
  151. my $p_i = 0;
  152. while ($p_i == 0 or exists $Q{$p_i}) {
  153. $p_i = $p_min_i + urandomm($p_max_i - $p_min_i + 1);
  154. }
  155. my $fb = $factor_base->[$p_i];
  156. $A *= $fb->{p};
  157. $log_A += log($fb->{p});
  158. $Q{$p_i} = $fb;
  159. }
  160. my $ratio = exp($log_A - $target0);
  161. # ratio too small seems to be not good
  162. if ( !defined($best_ratio)
  163. or ($ratio >= 0.9 and $ratio < $best_ratio)
  164. or ($best_ratio < 0.9 and $ratio > $best_ratio)) {
  165. $best_q = \%Q;
  166. $best_a = $A;
  167. $best_ratio = $ratio;
  168. }
  169. }
  170. my $A = $best_a;
  171. my $B = $ZERO;
  172. my @arr;
  173. foreach my $fb (values %$best_q) {
  174. my $p = $fb->{p};
  175. #($A % $p == 0) or die 'error';
  176. my $r = $A / $p;
  177. #$fb->{t} // die 'error';
  178. #gcd($r, $p) == 1 or die 'error';
  179. my $gamma = ($fb->{t} * int(invmod($r, $p))) % $p;
  180. if ($gamma > ($p >> 1)) {
  181. $gamma = $p - $gamma;
  182. }
  183. my $t = $r * $gamma;
  184. $B += $t;
  185. push @arr, $t;
  186. }
  187. my ($g, $h) = siqs_create_poly($A, $B, $n, $factor_base, 1);
  188. return ($g, $h, \@arr);
  189. }
  190. sub siqs_find_next_poly ($n, $factor_base, $i, $g, $arr) {
  191. # Compute the (i+1)-th polynomials for the Self-Initializing
  192. # Quadratic Sieve, given that g is the i-th polynomial.
  193. my $v = valuation($i, 2);
  194. my $z = ((($i >> ($v + 1)) & 1) == 0) ? -1 : 1;
  195. my $A = $g->{a};
  196. my $B = ($g->{b} + 2 * $z * $arr->[$v]) % $A;
  197. return siqs_create_poly($A, $B, $n, $factor_base, 0);
  198. }
  199. sub siqs_sieve ($factor_base, $m) {
  200. # Perform the sieving step of the SIQS. Return the sieve array.
  201. my @sieve_array = (0) x (2 * $m + 1);
  202. foreach my $fb (@$factor_base) {
  203. $fb->{p} > 100 or next;
  204. $fb->{soln1} // next;
  205. my $p = $fb->{p};
  206. my $lp = $fb->{lp};
  207. my $end = 2 * $m;
  208. my $i_start_1 = -int(($m + $fb->{soln1}) / $p);
  209. my $a_start_1 = int($fb->{soln1} + $i_start_1 * $p);
  210. for (my $i = $a_start_1 + $m ; $i <= $end ; $i += $p) {
  211. $sieve_array[$i] += $lp;
  212. }
  213. my $i_start_2 = -int(($m + $fb->{soln2}) / $p);
  214. my $a_start_2 = int($fb->{soln2} + $i_start_2 * $p);
  215. for (my $i = $a_start_2 + $m ; $i <= $end ; $i += $p) {
  216. $sieve_array[$i] += $lp;
  217. }
  218. }
  219. return \@sieve_array;
  220. }
  221. sub siqs_trial_divide ($n, $factor_base_info) {
  222. # Determine whether the given number can be fully factorized into
  223. # primes from the factors base. If so, return the indices of the
  224. # factors from the factor base. If not, return undef.
  225. my $factor_prod = $factor_base_info->{prod};
  226. state $g = Math::GMPz::Rmpz_init_nobless();
  227. state $t = Math::GMPz::Rmpz_init_nobless();
  228. Math::GMPz::Rmpz_set($t, $n);
  229. Math::GMPz::Rmpz_gcd($g, $t, $factor_prod);
  230. while (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
  231. Math::GMPz::Rmpz_remove($t, $t, $g);
  232. if (Math::GMPz::Rmpz_cmp_ui($t, 1) == 0) {
  233. my $factor_index = $factor_base_info->{index};
  234. return [map { [$factor_index->{$_->[0]}, $_->[1]] } factor_exp($n)];
  235. }
  236. Math::GMPz::Rmpz_gcd($g, $t, $g);
  237. }
  238. return undef;
  239. }
  240. sub siqs_trial_division ($n, $sieve_array, $factor_base_info, $smooth_relations, $g, $h, $m, $req_relations) {
  241. # Perform the trial division step of the Self-Initializing Quadratic Sieve.
  242. my $limit = (log("$m") + log("$n") / 2) / log(2) - SIQS_TRIAL_DIVISION_EPS;
  243. foreach my $i (0 .. $#{$sieve_array}) {
  244. next if ((my $sa = $sieve_array->[$i]) < $limit);
  245. my $x = $i - $m;
  246. my $gx = abs($g->eval($x));
  247. my $divisors_idx = siqs_trial_divide($gx, $factor_base_info) // next;
  248. my $u = $h->eval($x);
  249. my $v = $gx;
  250. #(($u * $u) % $n == ($v % $n)) or die 'error';
  251. push @$smooth_relations, [$u, $v, $divisors_idx];
  252. if (scalar(@$smooth_relations) >= $req_relations) {
  253. return 1;
  254. }
  255. }
  256. return 0;
  257. }
  258. sub siqs_build_matrix ($factor_base, $smooth_relations) {
  259. # Build the matrix for the linear algebra step of the Quadratic Sieve.
  260. my $fb = scalar(@$factor_base);
  261. my @matrix;
  262. foreach my $sr (@$smooth_relations) {
  263. my @row = (0) x $fb;
  264. foreach my $pair (@{$sr->[2]}) {
  265. $row[$pair->[0]] = $pair->[1] % 2;
  266. }
  267. push @matrix, \@row;
  268. }
  269. return \@matrix;
  270. }
  271. sub siqs_build_matrix_opt ($M) {
  272. # Convert the given matrix M of 0s and 1s into a list of numbers m
  273. # that correspond to the columns of the matrix.
  274. # The j-th number encodes the j-th column of matrix M in binary:
  275. # The i-th bit of m[i] is equal to M[i][j].
  276. my $m = scalar(@{$M->[0]});
  277. my @cols_binary = ("") x $m;
  278. foreach my $mi (@$M) {
  279. foreach my $j (0 .. $#{$mi}) {
  280. $cols_binary[$j] .= $mi->[$j];
  281. }
  282. }
  283. #<<<
  284. return ([map {
  285. Math::GMPz::Rmpz_init_set_str(scalar reverse($_), 2)
  286. } @cols_binary], scalar(@$M), $m);
  287. #>>>
  288. }
  289. sub find_pivot_column_opt ($M, $j) {
  290. # For a matrix produced by siqs_build_matrix_opt, return the row of
  291. # the first non-zero entry in column j, or None if no such row exists.
  292. my $v = $M->[$j];
  293. if ($v == 0) {
  294. return undef;
  295. }
  296. return valuation($v, 2);
  297. }
  298. sub siqs_solve_matrix_opt ($M, $n, $m) {
  299. # Perform the linear algebra step of the SIQS. Perform fast
  300. # Gaussian elimination to determine pairs of perfect squares mod n.
  301. # Use the optimizations described in [1].
  302. # [1] Koç, Çetin K., and Sarath N. Arachchige. 'A Fast Algorithm for
  303. # Gaussian Elimination over GF (2) and its Implementation on the
  304. # GAPP.' Journal of Parallel and Distributed Computing 13.1
  305. # (1991): 118-122.
  306. my @row_is_marked = (0) x $n;
  307. my @pivots = (-1) x $m;
  308. foreach my $j (0 .. $m - 1) {
  309. my $i = find_pivot_column_opt($M, $j) // next;
  310. $pivots[$j] = $i;
  311. $row_is_marked[$i] = 1;
  312. foreach my $k (0 .. $m - 1) {
  313. if ($k != $j and Math::GMPz::Rmpz_tstbit($M->[$k], $i)) {
  314. Math::GMPz::Rmpz_xor($M->[$k], $M->[$k], $M->[$j]);
  315. }
  316. }
  317. }
  318. my @perf_squares;
  319. foreach my $i (0 .. $n - 1) {
  320. if (not $row_is_marked[$i]) {
  321. my @perfect_sq_indices = ($i);
  322. foreach my $j (0 .. $m - 1) {
  323. if (Math::GMPz::Rmpz_tstbit($M->[$j], $i)) {
  324. push @perfect_sq_indices, $pivots[$j];
  325. }
  326. }
  327. push @perf_squares, \@perfect_sq_indices;
  328. }
  329. }
  330. return \@perf_squares;
  331. }
  332. sub siqs_calc_sqrts ($n, $square_indices, $smooth_relations) {
  333. # Given on of the solutions returned by siqs_solve_matrix_opt and
  334. # the corresponding smooth relations, calculate the pair [a, b], such
  335. # that a^2 = b^2 (mod n).
  336. my $r1 = $ONE;
  337. my $r2 = $ONE;
  338. foreach my $i (@$square_indices) {
  339. ($r1 *= $smooth_relations->[$i][0]) %= $n;
  340. ($r2 *= $smooth_relations->[$i][1]);
  341. }
  342. $r2 = Math::GMPz->new(sqrtint($r2));
  343. return ($r1, $r2);
  344. }
  345. sub siqs_factor_from_square ($n, $square_indices, $smooth_relations) {
  346. # Given one of the solutions returned by siqs_solve_matrix_opt,
  347. # return the factor f determined by f = gcd(a - b, n), where
  348. # a, b are calculated from the solution such that a*a = b*b (mod n).
  349. # Return f, a factor of n (possibly a trivial one).
  350. my ($sqrt1, $sqrt2) = siqs_calc_sqrts($n, $square_indices, $smooth_relations);
  351. #(($sqrt1 * $sqrt1) % $n == ($sqrt2 * $sqrt2) % $n) or die 'error';
  352. return Math::GMPz->new(gcd($sqrt1 - $sqrt2, $n));
  353. }
  354. sub siqs_find_more_factors_gcd (@numbers) {
  355. my %res;
  356. foreach my $i (0 .. $#numbers) {
  357. my $n = $numbers[$i];
  358. $res{$n} = $n;
  359. foreach my $k ($i + 1 .. $#numbers) {
  360. my $m = $numbers[$k];
  361. my $fact = Math::GMPz->new(gcd($n, $m));
  362. if ($fact != 1 and $fact != $n and $fact != $m) {
  363. if (not exists($res{$fact})) {
  364. say "SIQS: GCD found non-trivial factor: $fact";
  365. $res{$fact} = $fact;
  366. }
  367. my $t1 = $n / $fact;
  368. my $t2 = $m / $fact;
  369. $res{$t1} = $t1;
  370. $res{$t2} = $t2;
  371. }
  372. }
  373. }
  374. return (values %res);
  375. }
  376. sub siqs_find_factors ($n, $perfect_squares, $smooth_relations) {
  377. # Perform the last step of the Self-Initializing Quadratic Field.
  378. # Given the solutions returned by siqs_solve_matrix_opt, attempt to
  379. # identify a number of (not necessarily prime) factors of n, and
  380. # return them.
  381. my @factors;
  382. my $rem = $n;
  383. my %non_prime_factors;
  384. my %prime_factors;
  385. foreach my $square_indices (@$perfect_squares) {
  386. my $fact = siqs_factor_from_square($n, $square_indices, $smooth_relations);
  387. if ($fact > 1 and $fact < $rem) {
  388. if (is_prime($fact)) {
  389. if (not exists $prime_factors{$fact}) {
  390. say "SIQS: Prime factor found: $fact";
  391. $prime_factors{$fact} = $fact;
  392. }
  393. $rem = check_factor($rem, $fact, \@factors);
  394. if ($rem == 1) {
  395. last;
  396. }
  397. if (is_prime($rem)) {
  398. push @factors, $rem;
  399. $rem = 1;
  400. last;
  401. }
  402. if (defined(my $root = check_perfect_power($rem))) {
  403. say "SIQS: Perfect power detected with root: $root";
  404. push @factors, $root;
  405. $rem = 1;
  406. last;
  407. }
  408. }
  409. else {
  410. if (not exists $non_prime_factors{$fact}) {
  411. say "SIQS: Composite factor found: $fact";
  412. $non_prime_factors{$fact} = $fact;
  413. }
  414. }
  415. }
  416. }
  417. if ($rem != 1 and keys(%non_prime_factors)) {
  418. $non_prime_factors{$rem} = $rem;
  419. my @primes;
  420. my @composites;
  421. foreach my $fact (siqs_find_more_factors_gcd(values %non_prime_factors)) {
  422. if (is_prime($fact)) {
  423. push @primes, $fact;
  424. }
  425. elsif ($fact > 1) {
  426. push @composites, $fact;
  427. }
  428. }
  429. foreach my $fact (@primes, @composites) {
  430. if ($fact != $rem and $rem % $fact == 0) {
  431. say "SIQS: Using non-trivial factor from GCD: $fact";
  432. $rem = check_factor($rem, $fact, \@factors);
  433. }
  434. if ($rem == 1 or is_prime($rem)) {
  435. last;
  436. }
  437. }
  438. }
  439. if ($rem != 1) {
  440. push @factors, $rem;
  441. }
  442. return @factors;
  443. }
  444. sub siqs_choose_range ($n) {
  445. # Choose m for sieving in [-m, m].
  446. $n = "$n";
  447. return sprintf('%.0f', exp(sqrt(log($n) * log(log($n))) / 2));
  448. }
  449. sub siqs_choose_nf ($n) {
  450. # Choose parameters nf (sieve of factor base)
  451. $n = "$n";
  452. return sprintf('%.0f', exp(sqrt(log($n) * log(log($n))))**(sqrt(2) / 4));
  453. }
  454. sub siqs_choose_nf2 ($n) {
  455. # Choose parameters nf (sieve of factor base)
  456. $n = "$n";
  457. return sprintf('%.0f', exp(sqrt(log($n) * log(log($n))) / 2));
  458. }
  459. sub siqs_factorize ($n, $nf) {
  460. # Use the Self-Initializing Quadratic Sieve algorithm to identify
  461. # one or more non-trivial factors of the given number n. Return the
  462. # factors as a list.
  463. my $m = siqs_choose_range($n);
  464. my @factors;
  465. my $factor_base = siqs_factor_base_primes($n, $nf);
  466. my $factor_prod = Math::GMPz->new(vecprod(map { $_->{p} } @$factor_base));
  467. my %factor_base_index;
  468. @factor_base_index{map { $_->{p} } @{$factor_base}} = 0 .. $#{$factor_base};
  469. my $factor_base_info = {
  470. base => $factor_base,
  471. prod => $factor_prod,
  472. index => \%factor_base_index,
  473. };
  474. my $smooth_relations = [];
  475. my $required_relations_ratio = 1;
  476. my $success = 0;
  477. my $prev_cnt = 0;
  478. my $i_poly = 0;
  479. my ($g, $h, $arr);
  480. while (not $success) {
  481. say "*** Step 1/2: Finding smooth relations ***";
  482. say "SIQS sieving range: [-$m, $m]";
  483. my $required_relations = sprintf('%.0f', (scalar(@$factor_base) + 1) * $required_relations_ratio);
  484. say "Target: $required_relations relations.";
  485. my $enough_relations = 0;
  486. while (not $enough_relations) {
  487. if ($i_poly == 0) {
  488. ($g, $h, $arr) = siqs_find_first_poly($n, $m, $factor_base);
  489. }
  490. else {
  491. ($g, $h) = siqs_find_next_poly($n, $factor_base, $i_poly, $g, $arr);
  492. }
  493. if (++$i_poly >= (1 << $#{$arr})) {
  494. $i_poly = 0;
  495. }
  496. my $sieve_array = siqs_sieve($factor_base, $m);
  497. $enough_relations = siqs_trial_division($n, $sieve_array, $factor_base_info, $smooth_relations, $g, $h, $m, $required_relations);
  498. if ( scalar(@$smooth_relations) >= $required_relations
  499. or scalar(@$smooth_relations) > $prev_cnt) {
  500. printf("Progress: %d/%d relations.\r", scalar(@$smooth_relations), $required_relations);
  501. $prev_cnt = scalar(@$smooth_relations);
  502. }
  503. }
  504. say "\n\n*** Step 2/2: Linear Algebra ***";
  505. say "Building matrix for linear algebra step...";
  506. my $M = siqs_build_matrix($factor_base, $smooth_relations);
  507. my ($M_opt, $M_n, $M_m) = siqs_build_matrix_opt($M);
  508. say "Finding perfect squares using Gaussian elimination...";
  509. my $perfect_squares = siqs_solve_matrix_opt($M_opt, $M_n, $M_m);
  510. say "Finding factors from congruences of squares...\n";
  511. @factors = siqs_find_factors($n, $perfect_squares, $smooth_relations);
  512. if (scalar(@factors) > 1) {
  513. $success = 1;
  514. }
  515. else {
  516. say "Failed to find a solution. Finding more relations...";
  517. $required_relations_ratio += 0.05;
  518. }
  519. }
  520. return @factors;
  521. }
  522. sub check_factor ($n, $i, $factors) {
  523. while ($n % $i == 0) {
  524. $n /= $i;
  525. push @$factors, $i;
  526. if (is_prime($n)) {
  527. push @$factors, $n;
  528. return 1;
  529. }
  530. }
  531. return $n;
  532. }
  533. sub trial_division_small_primes ($n) {
  534. # Perform trial division on the given number n using all primes up
  535. # to upper_bound. Initialize the global variable small_primes with a
  536. # list of all primes <= upper_bound. Return (factors, rem), where
  537. # factors is the list of identified prime factors of n, and rem is the
  538. # remaining factor. If rem = 1, the function terminates early, without
  539. # fully initializing small_primes.
  540. say "[*] Trial division...";
  541. my $factors = [];
  542. my $rem = $n;
  543. foreach my $p (@small_primes) {
  544. if (Math::GMPz::Rmpz_divisible_ui_p($rem, $p)) {
  545. $rem = check_factor($rem, $p, $factors);
  546. last if ($rem == 1);
  547. }
  548. }
  549. return ($factors, $rem);
  550. }
  551. sub fast_fibonacci_factor ($n, $upto) {
  552. my $g = Math::GMPz::Rmpz_init();
  553. my ($P, $Q) = (3, 1);
  554. my $U0 = Math::GMPz::Rmpz_init_set_ui(0);
  555. my $U1 = Math::GMPz::Rmpz_init_set_ui(1);
  556. my $V0 = Math::GMPz::Rmpz_init_set_ui(2);
  557. my $V1 = Math::GMPz::Rmpz_init_set_ui($P);
  558. foreach my $k (2 .. $upto) {
  559. # my ($U, $V) = Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k);
  560. Math::GMPz::Rmpz_set($g, $U1);
  561. Math::GMPz::Rmpz_mul_ui($U1, $U1, $P);
  562. Math::GMPz::Rmpz_submul_ui($U1, $U0, $Q);
  563. Math::GMPz::Rmpz_mod($U1, $U1, $n);
  564. Math::GMPz::Rmpz_set($U0, $g);
  565. Math::GMPz::Rmpz_set($g, $V1);
  566. Math::GMPz::Rmpz_mul_ui($V1, $V1, $P);
  567. Math::GMPz::Rmpz_submul_ui($V1, $V0, $Q);
  568. Math::GMPz::Rmpz_mod($V1, $V1, $n);
  569. Math::GMPz::Rmpz_set($V0, $g);
  570. foreach my $param ([$U1, 0], [$V1, -$P, 0]) {
  571. my ($t, @deltas) = @$param;
  572. foreach my $delta (@deltas) {
  573. ($delta >= 0)
  574. ? Math::GMPz::Rmpz_add_ui($g, $t, $delta)
  575. : Math::GMPz::Rmpz_sub_ui($g, $t, -$delta);
  576. Math::GMPz::Rmpz_gcd($g, $g, $n);
  577. if ( Math::GMPz::Rmpz_cmp_ui($g, 12345) > 0
  578. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  579. return $g;
  580. }
  581. }
  582. }
  583. }
  584. return undef;
  585. }
  586. sub fast_power_check ($n, $upto) {
  587. state $t = Math::GMPz::Rmpz_init_nobless();
  588. state $g = Math::GMPz::Rmpz_init_nobless();
  589. my $base_limit = vecmin(logint($n, 2), 150);
  590. foreach my $base (2 .. $base_limit) {
  591. Math::GMPz::Rmpz_set_ui($t, $base);
  592. foreach my $exp (2 .. $upto) {
  593. Math::GMPz::Rmpz_mul_ui($t, $t, $base);
  594. foreach my $k ($base <= 10 ? (1 .. ($base_limit >> 1)) : 1) {
  595. Math::GMPz::Rmpz_mul_ui($g, $t, $k);
  596. Math::GMPz::Rmpz_sub_ui($g, $g, 1);
  597. Math::GMPz::Rmpz_gcd($g, $g, $n);
  598. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0 and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  599. my $r = Math::GMPz::Rmpz_init_set($g);
  600. return $r if ($r > 12345);
  601. }
  602. Math::GMPz::Rmpz_mul_ui($g, $t, $k);
  603. Math::GMPz::Rmpz_add_ui($g, $g, 1);
  604. Math::GMPz::Rmpz_gcd($g, $g, $n);
  605. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0 and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  606. my $r = Math::GMPz::Rmpz_init_set($g);
  607. return $r if ($r > 12345);
  608. }
  609. }
  610. }
  611. }
  612. return undef;
  613. }
  614. sub cyclotomic_polynomial ($n, $x) {
  615. my @d;
  616. foreach my $p (map { $_->[0] } factor_exp($n)) {
  617. push @d, map { [$_->[0] * $p, $_->[1] + 1] } @d;
  618. push @d, [$p, 1];
  619. }
  620. push @d, [1, 0];
  621. my $t = Math::GMPz::Rmpz_init();
  622. my $u = Math::GMPz::Rmpz_init_set_ui(1);
  623. my $v = Math::GMPz::Rmpz_init_set_ui(1);
  624. foreach my $pp (@d) {
  625. Math::GMPz::Rmpz_ui_pow_ui($t, $x, int($n / $pp->[0]));
  626. Math::GMPz::Rmpz_sub_ui($t, $t, 1);
  627. if ($pp->[1] % 2 == 0) {
  628. Math::GMPz::Rmpz_mul($u, $u, $t);
  629. }
  630. else {
  631. Math::GMPz::Rmpz_mul($v, $v, $t);
  632. }
  633. }
  634. Math::GMPz::Rmpz_divexact($u, $u, $v);
  635. return $u;
  636. }
  637. sub cyclotomic_factorization ($n) {
  638. my $g = Math::GMPz::Rmpz_init();
  639. my $base_limit = vecmin(1 + logint($n, 2), 500);
  640. for (my $base = $base_limit ; $base >= 2 ; $base -= 1) {
  641. my $lim = 1 + logint($n, $base);
  642. foreach my $k (1 .. $lim) {
  643. my $c = cyclotomic_polynomial($k, $base);
  644. Math::GMPz::Rmpz_gcd($g, $n, $c);
  645. if ( Math::GMPz::Rmpz_cmp_ui($g, 1) > 0
  646. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  647. return $g if ($g > 1e7);
  648. }
  649. }
  650. }
  651. return undef;
  652. }
  653. sub fast_lucasVmod ($P, $n, $m) { # assumes Q = 1
  654. my ($V1, $V2) = (Math::GMPz::Rmpz_init_set_ui(2), Math::GMPz::Rmpz_init_set($P));
  655. my ($Q1, $Q2) = (Math::GMPz::Rmpz_init_set_ui(1), Math::GMPz::Rmpz_init_set_ui(1));
  656. foreach my $bit (ntheory::todigits($n, 2)) {
  657. Math::GMPz::Rmpz_mul($Q1, $Q1, $Q2);
  658. Math::GMPz::Rmpz_mod($Q1, $Q1, $m);
  659. if ($bit) {
  660. Math::GMPz::Rmpz_mul($V1, $V1, $V2);
  661. Math::GMPz::Rmpz_powm_ui($V2, $V2, 2, $m);
  662. Math::GMPz::Rmpz_submul($V1, $Q1, $P);
  663. Math::GMPz::Rmpz_submul_ui($V2, $Q2, 2);
  664. Math::GMPz::Rmpz_mod($V1, $V1, $m);
  665. }
  666. else {
  667. Math::GMPz::Rmpz_set($Q2, $Q1);
  668. Math::GMPz::Rmpz_mul($V2, $V2, $V1);
  669. Math::GMPz::Rmpz_powm_ui($V1, $V1, 2, $m);
  670. Math::GMPz::Rmpz_submul($V2, $Q1, $P);
  671. Math::GMPz::Rmpz_submul_ui($V1, $Q2, 2);
  672. Math::GMPz::Rmpz_mod($V2, $V2, $m);
  673. }
  674. }
  675. Math::GMPz::Rmpz_mod($V1, $V1, $m);
  676. return $V1;
  677. }
  678. sub chebyshev_factorization ($n, $B, $A = 127) {
  679. # The Chebyshev factorization method, taking
  680. # advantage of the smoothness of p-1 or p+1.
  681. my $x = Math::GMPz::Rmpz_init_set_ui($A);
  682. my $i = Math::GMPz::Rmpz_init_set_ui(2);
  683. Math::GMPz::Rmpz_invert($i, $i, $n);
  684. my sub chebyshevTmod ($A, $x) {
  685. Math::GMPz::Rmpz_mul_2exp($x, $x, 1);
  686. Math::GMPz::Rmpz_set($x, fast_lucasVmod($x, $A, $n));
  687. Math::GMPz::Rmpz_mul($x, $x, $i);
  688. Math::GMPz::Rmpz_mod($x, $x, $n);
  689. }
  690. my $g = Math::GMPz::Rmpz_init();
  691. my $lnB = log($B);
  692. foreach my $p (sieve_primes(2, $B)) {
  693. chebyshevTmod($p**int($lnB / log($p)), $x); # T_k(x) (mod n)
  694. Math::GMPz::Rmpz_sub_ui($g, $x, 1);
  695. Math::GMPz::Rmpz_gcd($g, $g, $n);
  696. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
  697. return undef if (Math::GMPz::Rmpz_cmp($g, $n) == 0);
  698. return $g;
  699. }
  700. }
  701. return undef;
  702. }
  703. sub fibonacci_factorization ($n, $bound) {
  704. # The Fibonacci factorization method, taking
  705. # advantage of the smoothness of `p - legendre(p, 5)`.
  706. my ($P, $Q) = (1, 0);
  707. for (my $k = 2 ; ; ++$k) {
  708. my $D = (-1)**$k * (2 * $k + 1);
  709. if (Math::GMPz::Rmpz_si_kronecker($D, $n) == -1) {
  710. $Q = (1 - $D) / 4;
  711. last;
  712. }
  713. }
  714. state %cache;
  715. my $g = Math::GMPz::Rmpz_init();
  716. for (; ;) {
  717. return undef if $bound <= 1;
  718. my $d = ($cache{$bound} //= consecutive_integer_lcm($bound));
  719. my ($U, $V) = map { Math::GMPz::Rmpz_init_set_str($_, 10) } lucas_sequence($n, $P, $Q, $d);
  720. foreach my $t ($U, $V - 2, $V, $V + 2) {
  721. Math::GMPz::Rmpz_gcd($g, $t, $n);
  722. if ( Math::GMPz::Rmpz_cmp_ui($g, 1) > 0
  723. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  724. return $g;
  725. }
  726. }
  727. if ($U == 0) {
  728. say ":: p±1 seems to be $bound-smooth...";
  729. $bound >>= 1;
  730. next;
  731. }
  732. return undef;
  733. #say "=> Lucas p±1...";
  734. #return lucas_factorization($n, Math::GMPz::Rmpz_init_set_str($d, 10));
  735. }
  736. }
  737. sub lucas_factorization ($n, $d) {
  738. # The Lucas factorization method, taking
  739. # advantage of the smoothness of p-1 or p+1.
  740. my $Q;
  741. for (my $k = 2 ; ; ++$k) {
  742. my $D = (-1)**$k * (2 * $k + 1);
  743. if (Math::GMPz::Rmpz_si_kronecker($D, $n) == -1) {
  744. $Q = (1 - $D) / 4;
  745. last;
  746. }
  747. }
  748. my $s = Math::GMPz::Rmpz_scan1($d, 0);
  749. my $U1 = Math::GMPz::Rmpz_init_set_ui(1);
  750. my ($V1, $V2) = (Math::GMPz::Rmpz_init_set_ui(2), Math::GMPz::Rmpz_init_set_ui(1));
  751. my ($Q1, $Q2) = (Math::GMPz::Rmpz_init_set_ui(1), Math::GMPz::Rmpz_init_set_ui(1));
  752. foreach my $bit (split(//, substr(Math::GMPz::Rmpz_get_str($d, 2), 0, -$s - 1))) {
  753. Math::GMPz::Rmpz_mul($Q1, $Q1, $Q2);
  754. Math::GMPz::Rmpz_mod($Q1, $Q1, $n);
  755. if ($bit) {
  756. Math::GMPz::Rmpz_mul_si($Q2, $Q1, $Q);
  757. Math::GMPz::Rmpz_mul($U1, $U1, $V2);
  758. Math::GMPz::Rmpz_mul($V1, $V1, $V2);
  759. Math::GMPz::Rmpz_powm_ui($V2, $V2, 2, $n);
  760. Math::GMPz::Rmpz_sub($V1, $V1, $Q1);
  761. Math::GMPz::Rmpz_submul_ui($V2, $Q2, 2);
  762. Math::GMPz::Rmpz_mod($V1, $V1, $n);
  763. Math::GMPz::Rmpz_mod($U1, $U1, $n);
  764. }
  765. else {
  766. Math::GMPz::Rmpz_set($Q2, $Q1);
  767. Math::GMPz::Rmpz_mul($U1, $U1, $V1);
  768. Math::GMPz::Rmpz_mul($V2, $V2, $V1);
  769. Math::GMPz::Rmpz_sub($U1, $U1, $Q1);
  770. Math::GMPz::Rmpz_powm_ui($V1, $V1, 2, $n);
  771. Math::GMPz::Rmpz_sub($V2, $V2, $Q1);
  772. Math::GMPz::Rmpz_submul_ui($V1, $Q2, 2);
  773. Math::GMPz::Rmpz_mod($V2, $V2, $n);
  774. Math::GMPz::Rmpz_mod($U1, $U1, $n);
  775. }
  776. }
  777. Math::GMPz::Rmpz_mul($Q1, $Q1, $Q2);
  778. Math::GMPz::Rmpz_mul_si($Q2, $Q1, $Q);
  779. Math::GMPz::Rmpz_mul($U1, $U1, $V1);
  780. Math::GMPz::Rmpz_mul($V1, $V1, $V2);
  781. Math::GMPz::Rmpz_sub($U1, $U1, $Q1);
  782. Math::GMPz::Rmpz_sub($V1, $V1, $Q1);
  783. Math::GMPz::Rmpz_mul($Q1, $Q1, $Q2);
  784. my $t = Math::GMPz::Rmpz_init();
  785. Math::GMPz::Rmpz_gcd($t, $U1, $n);
  786. if ( Math::GMPz::Rmpz_cmp_ui($t, 1) > 0
  787. and Math::GMPz::Rmpz_cmp($t, $n) < 0) {
  788. return $t;
  789. }
  790. Math::GMPz::Rmpz_gcd($t, $V1, $n);
  791. if ( Math::GMPz::Rmpz_cmp_ui($t, 1) > 0
  792. and Math::GMPz::Rmpz_cmp($t, $n) < 0) {
  793. return $t;
  794. }
  795. for (1 .. $s) {
  796. Math::GMPz::Rmpz_mul($U1, $U1, $V1);
  797. Math::GMPz::Rmpz_mod($U1, $U1, $n);
  798. Math::GMPz::Rmpz_powm_ui($V1, $V1, 2, $n);
  799. Math::GMPz::Rmpz_submul_ui($V1, $Q1, 2);
  800. Math::GMPz::Rmpz_powm_ui($Q1, $Q1, 2, $n);
  801. Math::GMPz::Rmpz_gcd($t, $U1, $n);
  802. if ( Math::GMPz::Rmpz_cmp_ui($t, 1) > 0
  803. and Math::GMPz::Rmpz_cmp($t, $n) < 0) {
  804. return $t;
  805. }
  806. Math::GMPz::Rmpz_gcd($t, $V1, $n);
  807. if ( Math::GMPz::Rmpz_cmp_ui($t, 1) > 0
  808. and Math::GMPz::Rmpz_cmp($t, $n) < 0) {
  809. return $t;
  810. }
  811. }
  812. return undef;
  813. }
  814. sub pollard_pm1_lcm_find_factor ($n, $bound) {
  815. # Pollard p-1 method (LCM).
  816. my $g = Math::GMPz::Rmpz_init();
  817. my $t = Math::GMPz::Rmpz_init_set_ui(random_prime(1e6));
  818. foreach my $p (sieve_primes(2, $bound)) {
  819. Math::GMPz::Rmpz_powm_ui($t, $t, $p**int(log(ULONG_MAX >> 32) / log($p)), $n);
  820. Math::GMPz::Rmpz_sub_ui($g, $t, 1);
  821. Math::GMPz::Rmpz_gcd($g, $g, $n);
  822. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
  823. return undef if ($g == $n);
  824. return $g;
  825. }
  826. }
  827. return undef;
  828. }
  829. sub pollard_pm1_factorial_find_factor ($n, $bound2) {
  830. # Pollard p-1 method (factorial).
  831. my $bound1 = 1e5;
  832. state %cache;
  833. my $g = Math::GMPz::Rmpz_init();
  834. my $t = Math::GMPz::Rmpz_init_set_ui(random_prime(1e6));
  835. if (exists $cache{$n}) {
  836. $t = $cache{$n}{value};
  837. $bound1 = $cache{$n}{bound};
  838. }
  839. else {
  840. foreach my $k (2 .. $bound1) {
  841. Math::GMPz::Rmpz_powm_ui($t, $t, $k, $n);
  842. Math::GMPz::Rmpz_sub_ui($g, $t, 1);
  843. Math::GMPz::Rmpz_gcd($g, $g, $n);
  844. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
  845. return undef if ($g == $n);
  846. return $g;
  847. }
  848. }
  849. }
  850. while ($bound1 >= $bound2) {
  851. $bound2 *= 2;
  852. }
  853. foreach my $p (sieve_primes($bound1, $bound2)) {
  854. Math::GMPz::Rmpz_powm_ui($t, $t, $p, $n);
  855. Math::GMPz::Rmpz_sub_ui($g, $t, 1);
  856. Math::GMPz::Rmpz_gcd($g, $g, $n);
  857. if (Math::GMPz::Rmpz_cmp_ui($g, 1) > 0) {
  858. return undef if ($g == $n);
  859. return $g;
  860. }
  861. }
  862. $cache{$n}{value} = $t;
  863. $cache{$n}{bound} = $bound2 + 1;
  864. return undef;
  865. }
  866. sub pollard_rho_find_factor ($n, $max_iter) {
  867. # Pollard rho method, using the polynomial:
  868. # f(x) = x^2 - 1, with x_0 = 1+floor(log_2(n)).
  869. state %cache;
  870. my $u = logint($n, 2) + 1;
  871. my $x = Math::GMPz::Rmpz_init_set_ui($u);
  872. my $y = Math::GMPz::Rmpz_init_set_ui($u * $u - 1);
  873. if (exists $cache{$n}) {
  874. $x = $cache{$n}{x};
  875. $y = $cache{$n}{y};
  876. }
  877. my $g = Math::GMPz::Rmpz_init();
  878. for (1 .. $max_iter) {
  879. # f(x) = x^2 - 1
  880. Math::GMPz::Rmpz_powm_ui($x, $x, 2, $n);
  881. Math::GMPz::Rmpz_sub_ui($x, $x, 1);
  882. # f(f(x)) = (x^2 - 1)^2 - 1 = (x^2 - 2) * x^2
  883. Math::GMPz::Rmpz_powm_ui($g, $y, 2, $n);
  884. Math::GMPz::Rmpz_sub_ui($y, $g, 2);
  885. Math::GMPz::Rmpz_mul($y, $y, $g);
  886. Math::GMPz::Rmpz_sub($g, $x, $y);
  887. Math::GMPz::Rmpz_gcd($g, $g, $n);
  888. if (Math::GMPz::Rmpz_cmp_ui($g, 1) != 0) {
  889. return undef if ($g == $n);
  890. return $g;
  891. }
  892. }
  893. $cache{$n}{x} = $x;
  894. $cache{$n}{y} = $y;
  895. return undef;
  896. }
  897. sub pollard_pm1_ntheory_factor ($n, $max_iter) {
  898. my ($p, $q) = Math::Prime::Util::GMP::pminus1_factor($n, $max_iter);
  899. return $p if defined($q);
  900. return undef;
  901. #return pollard_pm1_factorial_find_factor($n, $max_iter);
  902. }
  903. sub williams_pp1_ntheory_factor ($n, $max_iter) {
  904. my ($p, $q) = Math::Prime::Util::GMP::pplus1_factor($n, $max_iter);
  905. return $p if defined($q);
  906. return undef;
  907. }
  908. sub pollard_rho_ntheory_factor ($n, $max_iter) {
  909. my ($p, $q) =
  910. (rand(1) < 0.5)
  911. ? (Math::Prime::Util::GMP::prho_factor($n, $max_iter))
  912. : (Math::Prime::Util::GMP::pbrent_factor($n, $max_iter));
  913. return $p if defined($q);
  914. return undef;
  915. #return pollard_rho_find_factor($n, $max_iter >> 1);
  916. }
  917. sub pollard_rho_sqrt_find_factor ($n, $max_iter) {
  918. # Pollard rho method, using the polynomial:
  919. # f(x) = x^2 + c
  920. #
  921. # where
  922. # c = floor(sqrt(n)) - (floor(sqrt(n))^2 - n)
  923. # c = n + s - s^2, with s = floor(sqrt(n))
  924. #
  925. # and
  926. # x_0 = 3^2 + c
  927. my $s = Math::GMPz->new(sqrtint($n));
  928. my $c = $n + $s - $s * $s;
  929. my $a0 = 3;
  930. my $a1 = ($a0 * $a0 + $c);
  931. my $a2 = ($a1 * $a1 + $c);
  932. my $g = Math::GMPz::Rmpz_init();
  933. for (1 .. $max_iter) {
  934. Math::GMPz::Rmpz_sub($g, $a2, $a1);
  935. Math::GMPz::Rmpz_gcd($g, $g, $n);
  936. if (Math::GMPz::Rmpz_cmp_ui($g, 1) != 0) {
  937. return undef if ($g == $n);
  938. return $g;
  939. }
  940. Math::GMPz::Rmpz_powm_ui($a1, $a1, 2, $n);
  941. Math::GMPz::Rmpz_add($a1, $a1, $c);
  942. Math::GMPz::Rmpz_powm_ui($a2, $a2, 2, $n);
  943. Math::GMPz::Rmpz_add($a2, $a2, $c);
  944. Math::GMPz::Rmpz_powm_ui($a2, $a2, 2, $n);
  945. Math::GMPz::Rmpz_add($a2, $a2, $c);
  946. }
  947. return undef;
  948. }
  949. sub pollard_rho_exp_find_factor ($n, $max_iter) {
  950. my $B = logint($n, 5)**2;
  951. if ($B > 50_000) {
  952. $B = 50_000;
  953. }
  954. my $e = Math::GMPz::Rmpz_init_set_str(consecutive_integer_lcm($B), 10);
  955. my $c = 2 * $e - 1;
  956. my $x = Math::GMPz::Rmpz_init_set_ui(1);
  957. my $y = Math::GMPz::Rmpz_init();
  958. my $g = Math::GMPz::Rmpz_init();
  959. Math::GMPz::Rmpz_powm($x, $x, $e, $n);
  960. Math::GMPz::Rmpz_add($x, $x, $c);
  961. Math::GMPz::Rmpz_mod($x, $x, $n);
  962. Math::GMPz::Rmpz_powm($y, $x, $e, $n);
  963. Math::GMPz::Rmpz_add($y, $y, $c);
  964. Math::GMPz::Rmpz_mod($y, $y, $n);
  965. for (1 .. $max_iter) {
  966. Math::GMPz::Rmpz_powm($x, $x, $e, $n);
  967. Math::GMPz::Rmpz_add($x, $x, $c);
  968. Math::GMPz::Rmpz_mod($x, $x, $n);
  969. Math::GMPz::Rmpz_powm($y, $y, $e, $n);
  970. Math::GMPz::Rmpz_add($y, $y, $c);
  971. Math::GMPz::Rmpz_mod($y, $y, $n);
  972. Math::GMPz::Rmpz_powm($y, $y, $e, $n);
  973. Math::GMPz::Rmpz_add($y, $y, $c);
  974. Math::GMPz::Rmpz_mod($y, $y, $n);
  975. Math::GMPz::Rmpz_sub($g, $x, $y);
  976. Math::GMPz::Rmpz_gcd($g, $g, $n);
  977. if (Math::GMPz::Rmpz_cmp_ui($g, 1) != 0) {
  978. return undef if ($g == $n);
  979. return $g;
  980. }
  981. }
  982. return undef;
  983. }
  984. sub phi_finder_factor ($n, $max_iter) {
  985. # Phi-finder algorithm for semiprimes, due to Kyle Kloster (2010)
  986. my $E = $n - 2 * Math::GMPz->new(sqrtint($n)) + 1;
  987. my $E0 = Math::GMPz->new(powmod(2, -$E, $n));
  988. my $L = logint($n, 2);
  989. my $i = 0;
  990. while (Math::GMPz::Rmpz_scan1($E0, 0) < Math::GMPz::Rmpz_sizeinbase($E0, 2) - 1) {
  991. Math::GMPz::Rmpz_mul_2exp($E0, $E0, $L);
  992. Math::GMPz::Rmpz_mod($E0, $E0, $n);
  993. ++$i;
  994. return undef if ($i > $max_iter);
  995. }
  996. my $t = 0;
  997. foreach my $k (0 .. $L) {
  998. if (Math::GMPz->new(powmod(2, $k, $n)) == $E0) {
  999. $t = $k;
  1000. last;
  1001. }
  1002. }
  1003. my $phi = abs($i * $L - $E - $t);
  1004. my $q = ($n - $phi + 1);
  1005. my $p = ($q + Math::GMPz->new(sqrtint(abs($q * $q - 4 * $n)))) >> 1;
  1006. (($n % $p) == 0) ? $p : undef;
  1007. }
  1008. sub fermat_find_factor ($n, $max_iter) {
  1009. # Fermat's factorization method, trying to represent `n` as a difference of two squares:
  1010. # n = a^2 - b^2, where n = (a-b) * (a+b).
  1011. my $p = Math::GMPz::Rmpz_init(); # p = floor(sqrt(n))
  1012. my $q = Math::GMPz::Rmpz_init(); # q = p^2 - n
  1013. Math::GMPz::Rmpz_sqrtrem($p, $q, $n);
  1014. Math::GMPz::Rmpz_neg($q, $q);
  1015. for (my $j = 1 ; $j <= $max_iter ; ++$j) {
  1016. Math::GMPz::Rmpz_addmul_ui($q, $p, 2);
  1017. Math::GMPz::Rmpz_add_ui($q, $q, 1);
  1018. Math::GMPz::Rmpz_add_ui($p, $p, 1);
  1019. if (Math::GMPz::Rmpz_perfect_square_p($q)) {
  1020. Math::GMPz::Rmpz_sqrt($q, $q);
  1021. my $r = Math::GMPz::Rmpz_init();
  1022. Math::GMPz::Rmpz_sub($r, $p, $q);
  1023. return $r if ($r > 12345);
  1024. }
  1025. }
  1026. return undef;
  1027. }
  1028. sub holf_find_factor ($n, $max_iter) {
  1029. # Hart’s One-Line Factoring Algorithm
  1030. my $m = Math::GMPz::Rmpz_init();
  1031. my $s = Math::GMPz::Rmpz_init();
  1032. foreach my $i (1 .. $max_iter) {
  1033. Math::GMPz::Rmpz_mul_ui($s, $n, 4 * $i);
  1034. Math::GMPz::Rmpz_sqrt($s, $s);
  1035. Math::GMPz::Rmpz_add_ui($s, $s, 1);
  1036. Math::GMPz::Rmpz_mul($m, $s, $s);
  1037. Math::GMPz::Rmpz_mod($m, $m, $n);
  1038. if (Math::GMPz::Rmpz_perfect_square_p($m)) {
  1039. Math::GMPz::Rmpz_sqrt($m, $m);
  1040. Math::GMPz::Rmpz_sub($m, $s, $m);
  1041. Math::GMPz::Rmpz_gcd($m, $m, $n);
  1042. if ( Math::GMPz::Rmpz_cmp_ui($m, 1) > 0
  1043. and Math::GMPz::Rmpz_cmp($m, $n) < 0) {
  1044. return $m if ($m > 12345);
  1045. }
  1046. }
  1047. }
  1048. return undef;
  1049. }
  1050. sub miller_rabin_factor ($n, $tries) {
  1051. # Miller-Rabin factorization method.
  1052. # https://en.wikipedia.org/wiki/Miller%E2%80%93Rabin_primality_test
  1053. my $D = $n - 1;
  1054. my $s = Math::GMPz::Rmpz_scan1($D, 0);
  1055. my $r = $s - 1;
  1056. my $d = $D >> $s;
  1057. if ($s > 20 and $tries > 10) {
  1058. $tries = 10;
  1059. }
  1060. my $x = Math::GMPz::Rmpz_init();
  1061. my $g = Math::GMPz::Rmpz_init();
  1062. for (1 .. $tries) {
  1063. my $p = random_prime(1e7);
  1064. Math::GMPz::Rmpz_powm($x, Math::GMPz::Rmpz_init_set_ui($p), $d, $n);
  1065. foreach my $k (0 .. $r) {
  1066. last if (Math::GMPz::Rmpz_cmp_ui($x, 1) == 0);
  1067. last if (Math::GMPz::Rmpz_cmp($x, $D) == 0);
  1068. foreach my $i (1, -1) {
  1069. Math::GMPz::Rmpz_gcd($g, $x + $i, $n);
  1070. if ( Math::GMPz::Rmpz_cmp_ui($g, 1) > 0
  1071. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  1072. if ($g > 12345) {
  1073. return $g;
  1074. }
  1075. }
  1076. }
  1077. Math::GMPz::Rmpz_powm_ui($x, $x, 2, $n);
  1078. }
  1079. }
  1080. return undef;
  1081. }
  1082. sub lucas_miller_factor ($n, $I, $tries) {
  1083. # Lucas-Miller factorization method.
  1084. my $D = $n + $I;
  1085. my $s = Math::GMPz::Rmpz_scan1($D, 0);
  1086. my $r = $s;
  1087. my $d = $D >> $s;
  1088. if ($s > 10 and $tries > 5) {
  1089. $tries = 5;
  1090. }
  1091. my $x = Math::GMPz::Rmpz_init();
  1092. my $g = Math::GMPz::Rmpz_init();
  1093. foreach my $i (1 .. $tries) {
  1094. my $P = 1 + int(rand(1e6));
  1095. my $Q = 1 + int(rand(1e6));
  1096. $Q *= -1 if (rand(1) < 0.5);
  1097. next if ntheory::is_square($P * $P - 4 * $Q);
  1098. Math::GMPz::Rmpz_set($x, $d);
  1099. foreach my $k (0 .. $r) {
  1100. my ($U, $V) = lucas_sequence($n, $P, $Q, $x);
  1101. foreach my $t ($U, $V) {
  1102. Math::GMPz::Rmpz_set_str($g, $t, 10);
  1103. Math::GMPz::Rmpz_gcd($g, $g, $n);
  1104. if ( Math::GMPz::Rmpz_cmp_ui($g, 1) > 0
  1105. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  1106. return $g if ($g > 12345);
  1107. }
  1108. }
  1109. Math::GMPz::Rmpz_set_str($g, $V, 10);
  1110. Math::GMPz::Rmpz_sub_ui($g, $g, $P);
  1111. Math::GMPz::Rmpz_gcd($g, $g, $n);
  1112. if ( Math::GMPz::Rmpz_cmp_ui($g, 1) > 0
  1113. and Math::GMPz::Rmpz_cmp($g, $n) < 0) {
  1114. return $g if ($g > 12345);
  1115. }
  1116. Math::GMPz::Rmpz_mul_2exp($x, $x, 1);
  1117. }
  1118. }
  1119. return undef;
  1120. }
  1121. sub simple_cfrac_find_factor ($n, $max_iter) {
  1122. # Simple version of the continued-fraction factorization method.
  1123. # Efficient for numbers that have factors relatively close to sqrt(n)
  1124. my $x = Math::GMPz::Rmpz_init();
  1125. my $y = Math::GMPz::Rmpz_init();
  1126. my $z = Math::GMPz::Rmpz_init_set_ui(1);
  1127. my $t = Math::GMPz::Rmpz_init();
  1128. my $w = Math::GMPz::Rmpz_init();
  1129. my $r = Math::GMPz::Rmpz_init();
  1130. Math::GMPz::Rmpz_sqrt($x, $n);
  1131. Math::GMPz::Rmpz_set($y, $x);
  1132. Math::GMPz::Rmpz_add($w, $x, $x);
  1133. Math::GMPz::Rmpz_set($r, $w);
  1134. my $f2 = Math::GMPz::Rmpz_init_set($x);
  1135. my $f1 = Math::GMPz::Rmpz_init_set_ui(1);
  1136. foreach (1 .. $max_iter) {
  1137. # y = r*z - y
  1138. Math::GMPz::Rmpz_mul($t, $r, $z);
  1139. Math::GMPz::Rmpz_sub($y, $t, $y);
  1140. # z = (n - y*y) / z
  1141. Math::GMPz::Rmpz_mul($t, $y, $y);
  1142. Math::GMPz::Rmpz_sub($t, $n, $t);
  1143. Math::GMPz::Rmpz_divexact($z, $t, $z);
  1144. # r = (x + y) / z
  1145. Math::GMPz::Rmpz_add($t, $x, $y);
  1146. Math::GMPz::Rmpz_div($r, $t, $z);
  1147. # f1 = (f1 + r*f2) % n
  1148. Math::GMPz::Rmpz_addmul($f1, $f2, $r);
  1149. Math::GMPz::Rmpz_mod($f1, $f1, $n);
  1150. # swap f1 with f2
  1151. ($f1, $f2) = ($f2, $f1);
  1152. if (Math::GMPz::Rmpz_perfect_square_p($z)) {
  1153. my $g = Math::GMPz->new(gcd($f1 - Math::GMPz->new(sqrtint($z)), $n));
  1154. if ($g > 1 and $g < $n) {
  1155. return $g if ($g > 12345);
  1156. }
  1157. }
  1158. last if ($z == 1);
  1159. }
  1160. return undef;
  1161. }
  1162. sub store_factor ($rem, $f, $factors) {
  1163. $f || return;
  1164. if (ref($f) ne 'Math::GMPz') {
  1165. $f =~ /^[0-9]+\z/ or return;
  1166. $f = Math::GMPz->new($f);
  1167. }
  1168. $f < $$rem or return;
  1169. $$rem % $f == 0 or die 'error';
  1170. if (is_prime($f)) {
  1171. say("`-> prime factor: ", $f);
  1172. $$rem = check_factor($$rem, $f, $factors);
  1173. }
  1174. else {
  1175. say("`-> composite factor: ", $f);
  1176. $$rem /= $f;
  1177. # Try to find a small factor of f
  1178. my $f_rem = find_small_factors($f, $factors);
  1179. if ($f_rem < $f) {
  1180. $$rem *= $f_rem;
  1181. }
  1182. else {
  1183. # Use SIQS to factorize f
  1184. find_prime_factors($f, $factors);
  1185. foreach my $p (@$factors) {
  1186. if ($$rem % $p == 0) {
  1187. $$rem = check_factor($$rem, $p, $factors);
  1188. last if $$rem == 1;
  1189. }
  1190. }
  1191. }
  1192. }
  1193. return 1;
  1194. }
  1195. sub find_small_factors ($rem, $factors) {
  1196. # Some special-purpose factorization methods to attempt to find small prime factors.
  1197. # Collect the identified prime factors in the `$factors` array and return 1 if all
  1198. # prime factors were found, or otherwise the remaining factor.
  1199. my %state = (
  1200. cyclotomic_check => 1,
  1201. fast_power_check => 1,
  1202. fast_fibonacci_check => 1,
  1203. );
  1204. my $len = length($rem);
  1205. if (0) {
  1206. foreach my $k (1 .. 10000) {
  1207. #use Math::Sidef qw(cyclotomic);
  1208. #my $c = cyclotomic($k, 2);
  1209. my $c = Math::GMPz->new(2)**$k - 1;
  1210. if (gcd($rem, $c) == $rem and $c != $rem) {
  1211. my @factors = factorize($c);
  1212. foreach my $f (@factors) {
  1213. store_factor(\$rem, $f, $factors);
  1214. }
  1215. if (is_prime($rem)) {
  1216. push(@$factors, $rem);
  1217. $rem = 1;
  1218. }
  1219. if ($rem == 1) {
  1220. return 1;
  1221. }
  1222. }
  1223. }
  1224. }
  1225. my @factorization_methods = (
  1226. sub {
  1227. say "=> Miller-Rabin method...";
  1228. miller_rabin_factor($rem, ($len > 1000) ? 15 : MILLER_RABIN_ITERATIONS);
  1229. },
  1230. sub {
  1231. if ($len < 3000) {
  1232. say "=> Lucas-Miller method (n+1)...";
  1233. lucas_miller_factor($rem, +1, ($len > 1000) ? 15 : LUCAS_MILLER_ITERATIONS);
  1234. }
  1235. },
  1236. sub {
  1237. if ($len < 3000) {
  1238. say "=> Lucas-Miller method (n-1)...";
  1239. lucas_miller_factor($rem, -1, ($len > 1000) ? 15 : LUCAS_MILLER_ITERATIONS);
  1240. }
  1241. },
  1242. #~ sub {
  1243. #~ say "=> Phi finder method...";
  1244. #~ phi_finder_factor($rem, PHI_FINDER_ITERATIONS);
  1245. #~ },
  1246. #~ sub {
  1247. #~ say "=> Fermat's method...";
  1248. #~ fermat_find_factor($rem, FERMAT_ITERATIONS);
  1249. #~ },
  1250. sub {
  1251. say "=> HOLF method...";
  1252. holf_find_factor($rem, HOLF_ITERATIONS);
  1253. },
  1254. #~ sub {
  1255. #~ say "=> CFRAC simple...";
  1256. #~ simple_cfrac_find_factor($rem, CFRAC_ITERATIONS);
  1257. #~ },
  1258. sub {
  1259. $state{fast_fibonacci_check} || return undef;
  1260. say "=> Fast Fibonacci check...";
  1261. my $f = fast_fibonacci_factor($rem, 5000);
  1262. $f // do { $state{fast_fibonacci_check} = 0 };
  1263. $f;
  1264. },
  1265. #~ sub {
  1266. #~ say "=> Pollard rho (11M)...";
  1267. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e11));
  1268. #~ },
  1269. sub {
  1270. say "=> Pollard p-1 (500K)...";
  1271. pollard_pm1_ntheory_factor($rem, 500_000);
  1272. },
  1273. #~ sub {
  1274. #~ say "=> Williams p±1 (500K)...";
  1275. #~ williams_pp1_ntheory_factor($rem, 500_000);
  1276. #~ },
  1277. #~ sub {
  1278. #~ if ($len < 1000) {
  1279. #~ say "=> Chebyshev p±1 (500K)...";
  1280. #~ chebyshev_factorization($rem, 500_000, int(rand(1e6)) + 2);
  1281. #~ }
  1282. #~ },
  1283. #~ sub {
  1284. #~ if ($len < 1000) {
  1285. #~ say "=> Chebyshev p±1 (1M)...";
  1286. #~ chebyshev_factorization($rem, 1_000_000, int(rand(1e6)) + 2);
  1287. #~ }
  1288. #~ },
  1289. #~ sub {
  1290. #~ say "=> Williams p±1 (1M)...";
  1291. #~ williams_pp1_ntheory_factor($rem, 1_000_000);
  1292. #~ },
  1293. sub {
  1294. if ($len < 500) {
  1295. say "=> Fibonacci p±1 (500K)...";
  1296. fibonacci_factorization($rem, 500_000);
  1297. }
  1298. },
  1299. sub {
  1300. $state{cyclotomic_check} || return undef;
  1301. say "=> Fast cyclotomic check...";
  1302. my $f = cyclotomic_factorization($rem);
  1303. $f // do { $state{cyclotomic_check} = 0 };
  1304. $f;
  1305. },
  1306. sub {
  1307. $state{fast_power_check} || return undef;
  1308. say "=> Fast power check...";
  1309. my $f = fast_power_check($rem, 500);
  1310. $f // do { $state{fast_power_check} = 0 };
  1311. $f;
  1312. },
  1313. #~ sub {
  1314. #~ say "=> Pollard rho (12M)...";
  1315. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e12));
  1316. #~ },
  1317. #~ sub {
  1318. #~ say "=> Pollard p-1 (5M)...";
  1319. #~ pollard_pm1_factorial_find_factor($rem, 5_000_000);
  1320. #~ },
  1321. #~ sub {
  1322. #~ say "=> Williams p±1 (3M)...";
  1323. #~ williams_pp1_ntheory_factor($rem, 3_000_000);
  1324. #~ },
  1325. #~ sub {
  1326. #~ say "=> Pollard rho (13M)...";
  1327. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e13));
  1328. #~ },
  1329. #~ sub {
  1330. #~ say "=> Williams p±1 (5M)...";
  1331. #~ williams_pp1_ntheory_factor($rem, 5_000_000);
  1332. #~ },
  1333. #~ sub {
  1334. #~ if ($len > 40) {
  1335. #~ say "=> Pollard rho (14M)...";
  1336. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e14));
  1337. #~ }
  1338. #~ },
  1339. #~ sub {
  1340. #~ say "=> Pollard p-1 (8M)...";
  1341. #~ pollard_pm1_ntheory_factor($rem, 8_000_000);
  1342. #~ },
  1343. #~ sub {
  1344. #~ if ($len < 150) {
  1345. #~ say "=> Pollard rho-exp...";
  1346. #~ pollard_rho_exp_find_factor($rem, ($len > 50 ? 2 : 1) * 200);
  1347. #~ }
  1348. #~ },
  1349. #~ sub {
  1350. #~ if ($len > 50) {
  1351. #~ say "=> Pollard p-1 (10M)...";
  1352. #~ pollard_pm1_factorial_find_factor($rem, 10_000_000);
  1353. #~ }
  1354. #~ },
  1355. #~ sub {
  1356. #~ if ($len > 50) {
  1357. #~ say "=> Williams p±1 (10M)...";
  1358. #~ williams_pp1_ntheory_factor($rem, 10_000_000);
  1359. #~ }
  1360. #~ },
  1361. #~ sub {
  1362. #~ if ($len > 70) {
  1363. #~ say "=> Pollard rho (15M)...";
  1364. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e15));
  1365. #~ }
  1366. #~ },
  1367. #~ sub {
  1368. #~ if ($len > 70) {
  1369. #~ say "=> Pollard p-1 (20M)...";
  1370. #~ pollard_pm1_factorial_find_factor($rem, 20_000_000);
  1371. #~ }
  1372. #~ },
  1373. #~ sub {
  1374. #~ if ($len > 70) {
  1375. #~ say "=> Williams p±1 (20M)...";
  1376. #~ williams_pp1_ntheory_factor($rem, 20_000_000);
  1377. #~ }
  1378. #~ },
  1379. #~ sub {
  1380. #~ if ($len > 70) {
  1381. #~ say "=> Pollard rho-exp...";
  1382. #~ pollard_rho_exp_find_factor($rem, 1000);
  1383. #~ }
  1384. #~ },
  1385. #~ sub {
  1386. #~ if ($len > 70) {
  1387. #~ say "=> Pollard rho (16M)...";
  1388. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e16));
  1389. #~ }
  1390. #~ },
  1391. #~ sub {
  1392. #~ if ($len > 70) {
  1393. #~ say "=> Pollard p-1 (50M)...";
  1394. #~ pollard_pm1_factorial_find_factor($rem, 50_000_000);
  1395. #~ }
  1396. #~ },
  1397. #~ sub {
  1398. #~ if ($len > 70) {
  1399. #~ say "=> Pollard p+1 (50M)...";
  1400. #~ williams_pp1_ntheory_factor($rem, 50_000_000);
  1401. #~ }
  1402. #~ },
  1403. #~ sub {
  1404. #~ if ($len > 70) {
  1405. #~ say "=> Pollard rho (16M)...";
  1406. #~ pollard_rho_ntheory_factor($rem, int sqrt(1e16));
  1407. #~ }
  1408. #~ },
  1409. );
  1410. MAIN_LOOP: for (; ;) {
  1411. if ($rem <= 1) {
  1412. last;
  1413. }
  1414. if (is_prime($rem)) {
  1415. push @$factors, $rem;
  1416. $rem = 1;
  1417. last;
  1418. }
  1419. $len = length($rem);
  1420. if ($len <= FACTOR_MIN_LEN) { # factorize with SIQS directly
  1421. return $rem;
  1422. }
  1423. if ( (Math::GMPz::Rmpz_popcount($rem + 1) == 1)
  1424. or (Math::GMPz::Rmpz_popcount($rem - 1) == 1)
  1425. or (Math::GMPz::Rmpz_popcount(($rem * 3) - 1) == 1)
  1426. or (Math::GMPz::Rmpz_popcount(($rem * 3) + 1) == 1)) {
  1427. return $rem;
  1428. }
  1429. printf("\n[*] Factoring %s (%s digits)...\n\n", ($len > MASK_LIMIT ? "C$len" : $rem), $len);
  1430. say "=> Perfect power check...";
  1431. if (defined(my $f = check_perfect_power($rem))) {
  1432. my $exp = 1;
  1433. for (my $t = $f ; $t < $rem ; ++$exp) {
  1434. $t *= $f;
  1435. }
  1436. my @r = (is_prime($f) ? $f : factorize($f));
  1437. push(@$factors, (@r) x $exp);
  1438. return 1;
  1439. }
  1440. foreach my $i (0 .. $#factorization_methods) {
  1441. my $code = $factorization_methods[$i];
  1442. my $f = $code->();
  1443. if (store_factor(\$rem, $f, $factors)) {
  1444. # Move the successful factorization method at the top
  1445. unshift(@factorization_methods, splice(@factorization_methods, $i, 1));
  1446. next MAIN_LOOP;
  1447. }
  1448. }
  1449. last;
  1450. }
  1451. return $rem;
  1452. }
  1453. sub check_perfect_power ($n) {
  1454. # Check whether n is a perfect and return its perfect root.
  1455. # Returns undef otherwise.
  1456. if ((my $exp = is_power($n)) > 1) {
  1457. my $root = Math::GMPz->new(rootint($n, $exp));
  1458. say "`-> perfect power: $root^$exp";
  1459. return $root;
  1460. }
  1461. return undef;
  1462. }
  1463. sub find_prime_factors ($n, $factors) {
  1464. # Return one or more prime factors of the given number n. Assume
  1465. # that n is not a prime and does not have very small factors.
  1466. if (length("$n") > 65) {
  1467. find_all_prime_factors($n, $factors);
  1468. return 1;
  1469. }
  1470. push @$factors, map { Math::GMPz->new("$_") } Math::Prime::Util::GMP::factor($n);
  1471. }
  1472. sub find_all_prime_factors ($n, $factors) {
  1473. if (!ref($n)) {
  1474. $n = Math::GMPz->new($n);
  1475. }
  1476. if (length("$n") < 45) {
  1477. say ":: Factoring with ntheory (<45 len)...";
  1478. push @$factors, map { Math::GMPz->new("$_") } ntheory::factor($n);
  1479. return 1;
  1480. }
  1481. state $t = do {
  1482. my $z = Math::GMPz::Rmpz_init_nobless();
  1483. Math::GMPz::Rmpz_primorial_ui($z, 1e7);
  1484. $z;
  1485. };
  1486. my $g = Math::GMPz::Rmpz_init();
  1487. Math::GMPz::Rmpz_gcd($g, $n, $t);
  1488. my $rem = $n / $g;
  1489. if ($g > $rem or ($g > ~0 and length("$rem") < 80)) {
  1490. say ":: Factoring with ntheory (small factors)...";
  1491. push @$factors, map { Math::GMPz->new("$_") } ntheory::factor($g);
  1492. push @$factors, map { Math::GMPz->new("$_") } ntheory::factor($rem);
  1493. return 1;
  1494. }
  1495. if (length("$n") > 50) {
  1496. say ":: Factoring with FactorDB...";
  1497. my @f;
  1498. if (SCRAPE_FACTORDB) {
  1499. chomp(@f = `$^X /home/swampyx/Other/Programare/experimental-projects/factordb/scrape_factordb.pl $n`);
  1500. }
  1501. else {
  1502. chomp(@f = `$^X /home/swampyx/Other/Programare/experimental-projects/factordb/get_factordb.pl $n`);
  1503. }
  1504. if (Math::GMPz->new(vecprod(@f)) == $n and vecall { is_prime($_) } @f) {
  1505. push @$factors, @f;
  1506. return 1;
  1507. }
  1508. say ":: FactorDB failed...";
  1509. }
  1510. if (length("$n") < 70) {
  1511. say ":: Factoring with ntheory (<70 len)...";
  1512. push @$factors, map { Math::GMPz->new("$_") } Math::Prime::Util::GMP::factor($n);
  1513. return 1;
  1514. }
  1515. say ":: Too large to factor...";
  1516. return 0;
  1517. }
  1518. sub special_form_factorization ($n) {
  1519. my %seen_divisor;
  1520. my @near_power_params;
  1521. my @diff_powers_params;
  1522. my @cong_powers_params;
  1523. my @sophie_params;
  1524. #
  1525. ## Close to a perfect power
  1526. #
  1527. my $near_power = sub ($r, $e, $k) {
  1528. my @factors;
  1529. foreach my $d (ntheory::divisors($e)) {
  1530. my $x = $r**$d;
  1531. foreach my $j (1, -1) {
  1532. my $t = $x - $k * $j;
  1533. my $g = Math::GMPz->new(gcd($t, $n));
  1534. if ($g > TRIAL_DIVISION_LIMIT and $g < $n and !$seen_divisor{$g}++) {
  1535. push @factors, $g;
  1536. }
  1537. }
  1538. }
  1539. @factors;
  1540. };
  1541. foreach my $j (1 .. NEAR_POWER_ITERATIONS) {
  1542. foreach my $k (1, -1) {
  1543. my $u = $k * $j * $j;
  1544. if ($n + $u > 0) {
  1545. if (my $e = is_power($n + $u)) {
  1546. my $r = Math::GMPz->new(rootint($n + $u, $e));
  1547. say "[*] Near power detected: $r^$e ", sprintf("%s %s", ($k == 1) ? ('-', $u) : ('+', -$u));
  1548. push @near_power_params, [$r, $e, $j];
  1549. }
  1550. }
  1551. }
  1552. }
  1553. #
  1554. ## Difference of powers
  1555. #
  1556. my $diff_powers = sub ($r1, $e1, $r2, $e2) {
  1557. my @factors;
  1558. my @d1 = ntheory::divisors($e1);
  1559. my @d2 = ntheory::divisors($e2);
  1560. foreach my $d1 (@d1) {
  1561. my $x = $r1**$d1;
  1562. foreach my $d2 (@d2) {
  1563. my $y = $r2**$d2;
  1564. foreach my $j (1, -1) {
  1565. my $t = $x - $j * $y;
  1566. my $g = Math::GMPz->new(gcd($t, $n));
  1567. if ($g > TRIAL_DIVISION_LIMIT and $g < $n and !$seen_divisor{$g}++) {
  1568. push @factors, $g;
  1569. }
  1570. }
  1571. }
  1572. }
  1573. @factors;
  1574. };
  1575. my $diff_power_check = sub ($r1, $e1) {
  1576. my $u = $r1**$e1;
  1577. my $dx = abs($u - $n);
  1578. if (Math::GMPz::Rmpz_perfect_power_p($dx)) {
  1579. my $e2 = is_power($dx) || 1;
  1580. my $r2 = Math::GMPz->new(rootint($dx, $e2));
  1581. if ($u > $n) {
  1582. say "[*] Difference of powers detected: ", sprintf("%s^%s - %s^%s", $r1, $e1, $r2, $e2);
  1583. }
  1584. else {
  1585. say "[*] Sum of powers detected: ", sprintf("%s^%s + %s^%s", $r1, $e1, $r2, $e2);
  1586. # Sophie Germain's identity:
  1587. # n^4 + 4^(2k+1) = n^4 + 4*(4^(2k)) = n^4 + 4*((2^k)^4)
  1588. if ($r1 == 4 and ($e1 % 2 == 1) and $e2 == 4) { # n = r1^(2k+1) + r2^4
  1589. push @sophie_params, [$r2, Math::GMPz->new(rootint($r1**($e1 - 1), 4))];
  1590. }
  1591. if ($r2 == 4 and ($e2 % 2 == 1) and $e1 == 4) { # n = r2^(2k+1) + r1^4
  1592. push @sophie_params, [$r1, Math::GMPz->new(rootint($r2**($e2 - 1), 4))];
  1593. }
  1594. }
  1595. push @diff_powers_params, [$r1, $e1, $r2, $e2];
  1596. }
  1597. };
  1598. # Sum and difference of powers of the form a^k ± b^k, where a and b are small.
  1599. foreach my $r1 (reverse 2 .. logint($n, 2)) {
  1600. my $t = logint($n, $r1);
  1601. $diff_power_check->(Math::GMPz->new($r1), $t); # sum of powers
  1602. $diff_power_check->(Math::GMPz->new($r1), $t + 1); # difference of powers
  1603. }
  1604. # Sum and difference of powers of the form a^k ± b^k, where a and b are large.
  1605. foreach my $e1 (reverse 2 .. logint($n, 2)) {
  1606. my $t = Math::GMPz->new(rootint($n, $e1));
  1607. $diff_power_check->($t, $e1); # sum of powers
  1608. $diff_power_check->($t + 1, $e1); # difference of powers
  1609. }
  1610. #
  1611. ## Congruence of powers
  1612. #
  1613. my $cong_powers = sub ($r, $e1, $k, $e2) {
  1614. my @factors;
  1615. my @divs1 = ntheory::divisors($e1);
  1616. my @divs2 = ntheory::divisors($e2);
  1617. foreach my $d1 (@divs1) {
  1618. my $x = $r**$d1;
  1619. foreach my $d2 (@divs2) {
  1620. my $y = $k**$d2;
  1621. foreach my $j (-1, 1) {
  1622. my $t = $x - $j * $y;
  1623. my $g = Math::GMPz->new(gcd($t, $n));
  1624. if ($g > TRIAL_DIVISION_LIMIT and $g < $n and !$seen_divisor{$g}++) {
  1625. if ($r == $k) {
  1626. say "[*] Congruence of powers: a^$d1 == b^$d2 (mod n) -> $g";
  1627. }
  1628. else {
  1629. say "[*] Congruence of powers: $r^$d1 == $k^$d2 (mod n) -> $g";
  1630. }
  1631. push @factors, $g;
  1632. }
  1633. }
  1634. }
  1635. }
  1636. @factors;
  1637. };
  1638. my @congrunce_range = reverse(2 .. 64);
  1639. my $process_congruence = sub ($root, $e) {
  1640. for my $j (1, 0) {
  1641. my $k = $root + $j;
  1642. my $u = Math::GMPz::Rmpz_init();
  1643. ref($k)
  1644. ? Math::GMPz::Rmpz_set($u, $k)
  1645. : Math::GMPz::Rmpz_set_ui($u, $k);
  1646. Math::GMPz::Rmpz_powm_ui($u, $u, $e, $n);
  1647. foreach my $z ($u, $n - $u) {
  1648. if (Math::GMPz::Rmpz_perfect_power_p($z)) {
  1649. my $t = is_power($z) || 1;
  1650. my $r1 = rootint($z, $t);
  1651. my $r2 = rootint($z, $e);
  1652. push @cong_powers_params, [Math::GMPz->new($r1), $t, Math::GMPz->new($k), $e];
  1653. push @cong_powers_params, [Math::GMPz->new($r2), $e, Math::GMPz->new($k), $e];
  1654. }
  1655. }
  1656. }
  1657. };
  1658. for my $e (@congrunce_range) {
  1659. my $root = Math::GMPz->new(rootint($n, $e));
  1660. $process_congruence->($root, $e);
  1661. }
  1662. for my $root (@congrunce_range) {
  1663. my $e = Math::GMPz->new(logint($n, $root));
  1664. $process_congruence->($root, $e);
  1665. }
  1666. # Sophie Germain's identity
  1667. # x^4 + 4y^4 = (x^2 + 2xy + 2y^2) * (x^2 - 2xy + 2y^2)
  1668. my $sophie = sub ($A, $B) {
  1669. my @factors;
  1670. foreach my $f (
  1671. #<<<
  1672. $A*$A + (($B*$B)<<1) - (($A*$B<<1)),
  1673. $A*$A + (($B*$B)<<1) + (($A*$B)<<1),
  1674. #>>>
  1675. ) {
  1676. my $g = Math::GMPz->new(gcd($f, $n));
  1677. if ($g > TRIAL_DIVISION_LIMIT and $g < $n and !$seen_divisor{$g}++) {
  1678. push @factors, $g;
  1679. }
  1680. }
  1681. @factors;
  1682. };
  1683. my $sophie_check_root = sub ($r1) {
  1684. {
  1685. my $x = 4 * $r1**4;
  1686. my $dx = $n - $x;
  1687. if (is_power($dx, 4)) {
  1688. my $r2 = Math::GMPz->new(rootint($dx, 4));
  1689. say "[*] Sophie Germain special form detected: $r2^4 + 4*$r1^4";
  1690. push @sophie_params, [$r2, $r1];
  1691. }
  1692. }
  1693. {
  1694. my $y = $r1**4;
  1695. my $dy = $n - $y;
  1696. if (($dy % 4 == 0) and is_power($dy >> 2, 4)) {
  1697. my $r2 = Math::GMPz->new(rootint($dy >> 2, 4));
  1698. say "[*] Sophie Germain special form detected: $r1^4 + 4*$r2^4";
  1699. push @sophie_params, [$r1, $r2];
  1700. }
  1701. }
  1702. };
  1703. # Try to find n = x^4 + 4*y^4, for x or y small.
  1704. foreach my $r1 (map { Math::GMPz->new($_) } 2 .. logint($n, 2)) {
  1705. $sophie_check_root->($r1);
  1706. }
  1707. { # Try to find n = x^4 + 4*y^4 for x and y close to floor(n/5)^(1/4).
  1708. my $k = Math::GMPz->new(rootint($n / 5, 4));
  1709. for my $j (0 .. 1000) {
  1710. $sophie_check_root->($k + $j);
  1711. }
  1712. }
  1713. my @divisors;
  1714. foreach my $args (@near_power_params) {
  1715. push @divisors, $near_power->(@$args);
  1716. }
  1717. foreach my $args (@diff_powers_params) {
  1718. push @divisors, $diff_powers->(@$args);
  1719. }
  1720. foreach my $args (@cong_powers_params) {
  1721. push @divisors, $cong_powers->(@$args);
  1722. }
  1723. foreach my $args (@sophie_params) {
  1724. push @divisors, $sophie->(@$args);
  1725. }
  1726. @divisors = sort { $a <=> $b } @divisors;
  1727. my @factors;
  1728. foreach my $d (@divisors) {
  1729. my $g = Math::GMPz->new(gcd($n, $d));
  1730. if ($g > TRIAL_DIVISION_LIMIT and $g < $n) {
  1731. while ($n % $g == 0) {
  1732. $n /= $g;
  1733. push @factors, $g;
  1734. }
  1735. }
  1736. }
  1737. return sort { $a <=> $b } @factors;
  1738. }
  1739. sub verify_prime_factors ($n, $factors) {
  1740. Math::GMPz->new(vecprod(@$factors)) == $n or die 'product of factors != n';
  1741. foreach my $p (@$factors) {
  1742. is_prime($p) or die "not prime detected: $p";
  1743. }
  1744. sort { $a <=> $b } @$factors;
  1745. }
  1746. sub factorize ($n) {
  1747. # Factorize the given integer n >= 1 into its prime factors.
  1748. if ($n < 1) {
  1749. die "Number needs to be an integer >= 1";
  1750. }
  1751. my $len = length($n);
  1752. printf("\n[*] Factoring %s (%d digits)...\n", $n, $len);
  1753. return () if ($n <= 1);
  1754. return ($n) if is_prime($n);
  1755. if (my $e = is_power($n)) {
  1756. my $root = Math::GMPz->new(rootint($n, $e));
  1757. say "[*] Perfect power detected: $root^$e";
  1758. my @factors = (is_prime($root) ? $root : factorize($root));
  1759. return verify_prime_factors($n, [(@factors) x $e]);
  1760. }
  1761. my @divisors = ((LOOK_FOR_SPECIAL_FORMS and $len > 65) ? special_form_factorization($n) : ());
  1762. if (@divisors) {
  1763. say "[*] Divisors found so far: ", join(', ', @divisors);
  1764. my @composite;
  1765. my @factors;
  1766. foreach my $d (@divisors) {
  1767. $d > 1 or next;
  1768. if (is_prime($d)) {
  1769. push @factors, $d;
  1770. }
  1771. else {
  1772. push @composite, $d;
  1773. }
  1774. }
  1775. push @factors, map { factorize($_) } reverse @composite;
  1776. my $rem = $n / Math::GMPz->new(vecprod(@factors));
  1777. if ($rem > 1) {
  1778. push @factors, factorize($rem);
  1779. }
  1780. return verify_prime_factors($n, \@factors);
  1781. }
  1782. my ($factors, $rem) = ([], $n);
  1783. if (@$factors) {
  1784. say "[*] Prime factors found so far: ", join(', ', @$factors);
  1785. }
  1786. else {
  1787. say "[*] No small factors found...";
  1788. }
  1789. if ($rem != 1) {
  1790. if (LOOK_FOR_SMALL_FACTORS) {
  1791. say "[*] Trying to find more small factors...";
  1792. $rem = find_small_factors($rem, $factors);
  1793. }
  1794. else {
  1795. say "[*] Skipping the search for more small factors...";
  1796. }
  1797. if ($rem > 1) {
  1798. find_all_prime_factors($rem, $factors);
  1799. }
  1800. }
  1801. return verify_prime_factors($n, $factors);
  1802. }
  1803. sub prefactorization ($n, $factors) {
  1804. if (length("$n") <= 45) {
  1805. say ":: Factoring $n with ntheory (<45 len)...";
  1806. push @$factors, Math::Prime::Util::GMP::factor($n);
  1807. return 1;
  1808. }
  1809. state $t = do {
  1810. my $z = Math::GMPz::Rmpz_init_nobless();
  1811. Math::GMPz::Rmpz_primorial_ui($z, 1e7);
  1812. $z;
  1813. };
  1814. my $g = Math::GMPz::Rmpz_init();
  1815. Math::GMPz::Rmpz_gcd($g, $n, $t);
  1816. my $rem = $n / $g;
  1817. if ($g > $rem or ($g > ~0 and length("$rem") < 80) or length("$rem") <= 50) {
  1818. say ":: Factoring $n with ntheory (small factors)...";
  1819. push @$factors, ntheory::factor($g);
  1820. push @$factors, ntheory::factor($rem);
  1821. @$factors = map { Math::GMPz->new("$_") } @$factors;
  1822. @$factors = sort { $a <=> $b } @$factors;
  1823. return 1;
  1824. }
  1825. return 0;
  1826. }
  1827. eval { require GDBM_File };
  1828. my $cache_db = "factors.db";
  1829. dbmopen(my %cache_db, $cache_db, 0666)
  1830. or die "Can't create/access database <<$cache_db>>: $!";
  1831. while (<>) {
  1832. next if /^\h*#/;
  1833. /\S/ or next;
  1834. my $n = (split(' ', $_))[-1];
  1835. $n || next;
  1836. $n =~ /^[0-9]+\z/ or next;
  1837. #~ next if ($n < ~0);
  1838. #~ next if length($n) >= 35;
  1839. next if ($n < ~0);
  1840. next if length($n) > MAX_SIZE;
  1841. #next if length($n) > 1000;
  1842. my $len = length($n);
  1843. next if exists($cache_db{$n});
  1844. #is_pseudoprime($n, 2) && next;
  1845. my @factors;
  1846. if ($len <= FACTOR_MIN_LEN) {
  1847. @factors = Math::Prime::Util::GMP::factor($n);
  1848. }
  1849. else {
  1850. $n = Math::GMPz::Rmpz_init_set_str($n, 10);
  1851. }
  1852. #~ if ( (Math::GMPz::Rmpz_popcount($n + 1) == 1)
  1853. #~ or (Math::GMPz::Rmpz_popcount($n - 1) == 1)
  1854. #~ or (Math::GMPz::Rmpz_popcount(($n * 3) - 1) == 1)
  1855. #~ or (Math::GMPz::Rmpz_popcount(($n * 3) + 1) == 1)) {
  1856. #~ next;
  1857. #~ }
  1858. #next if is_smooth($n, 1e7);
  1859. if (PREFACTORIZATION and not @factors) {
  1860. prefactorization($n, \@factors);
  1861. }
  1862. if (not @factors) {
  1863. if (FACTORIZE_WITH_SIDEF) {
  1864. @factors = map { Math::Sidef::factor($_) } Math::Sidef::special_factors($n, 0);
  1865. }
  1866. else {
  1867. @factors = eval { factorize($n) }
  1868. }
  1869. }
  1870. if (scalar(@factors) == 1) {
  1871. Math::Prime::Util::GMP::is_provable_prime($n) || die "BPSW counter-example(?): $n";
  1872. }
  1873. if ( scalar(@factors) > 1
  1874. and (vecall { is_prime($_) } @factors)
  1875. and Math::GMPz->new(vecprod(@factors)) == Math::GMPz->new($n)) {
  1876. say ":: Successfully factorized!";
  1877. $cache_db{"$n"} = join(' ', @factors);
  1878. }
  1879. }
  1880. dbmclose(%cache_db);