0
$\begingroup$

Is there an efficient way to check a number x and remove all prime factors in the number which are less than some n? For example for n = 200:

x=88984589931961415442566827779929187431222364934742868664124547963532933

FactorInteger[x]

{{29, 2}, {31, 1}, {37, 2}, {269, 1}, {271, 
  1}, {34200471605536976187361939984030218061598132568100785528233, 
  1}}

After removing all prime factors < n from x gives:

2493180179572040027082498062895818866472442266081979164222657467

I'd like to use as large n as possible and then use PrimeQ to check the remaining number, which is faster than checking for large prime factors.

I made this code which works but may be slow:

x=2*53*6571*18313*31259

n=20000;
n=PrimePi[n];
listWithSmallPrimeFactorsRemoved={};
AppendTo[listWithSmallPrimeFactorsRemoved,x];
For[i=1,i<=n,i++,
z=Last[listWithSmallPrimeFactorsRemoved];
a=IntegerExponent[z,Prime[i]];
z=z/(Prime[i]^a);
AppendTo[listWithSmallPrimeFactorsRemoved,z];
]
CountDistinct[listWithSmallPrimeFactorsRemoved]-1 (*count of how many prime factors were removed*)

Last[listWithSmallPrimeFactorsRemoved] (*the remaining number after removing prime factors \[LessEqual] n*)

cheers, Jamie

$\endgroup$
1
  • 1
    $\begingroup$ The combination of For and AppendTo is a good indicator for bad code in Mathematica. $\endgroup$ – Roman Feb 16 '20 at 18:01
1
$\begingroup$

Wasteful but works:

x = 88984589931961415442566827779929187431222364934742868664124547963532933;
n = 200;

FixedPoint[Numerator[#/n!] &, x]

(*    2493180179572040027082498062895818866472442266081979164222657467    *)

A bit less wasteful (Thanks @evanb!): only use prime factors,

A = Times @@ Prime[Range[PrimePi[n]]];
FixedPoint[Numerator[#/A] &, x]

(*    2493180179572040027082498062895818866472442266081979164222657467    *)

Or a bit more direct but much slower:

y = x;
Do[While[Divisible[y, i], y /= i], {i, 2, n}];
y

(*    2493180179572040027082498062895818866472442266081979164222657467    *)
$\endgroup$
1
  • $\begingroup$ You can accelerate the loop by just iterating over primes: y = x; i = 2; While[ i <= n, While[Divisible[y, i], y /= i]; i = NextPrime[i] ]; $\endgroup$ – evanb Feb 16 '20 at 17:15
1
$\begingroup$

Select should help you in this case:

n=200;

Select[FactorInteger[x], #[[1]] > n &]

{{269, 1}, {271, 1},{34200471605536976187361939984030218061598132568100785528233, 1}}

$\endgroup$
1
  • $\begingroup$ Hi, I will edit the question to be more clear, I actually don't need to factor the remaining number, only PrimeQ it. $\endgroup$ – Jamie M Feb 16 '20 at 15:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.