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
    Commented Feb 16, 2020 at 18:01

2 Answers 2

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
    Commented Feb 16, 2020 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
    Commented Feb 16, 2020 at 15:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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