1
$\begingroup$

I am trying to generate a list of cubefree numbers (i.e. numbers when prime factorized contain no tripled factors) within a given range.

Of DivisorSigma, PrimeOmega, Divisors, PrimeNu and FactorInteger, FactorInteger seems to me to be the best suited to the task (please feel free to suggest more suitable methods). For example,

FactorInteger[630]

outputs

{{2, 1}, {3, 2}, {5, 1}, {7, 1}}

From this, I would like Mathematica to focus on the second number in each pair (the exponent) and determine which has the highest value. In this case, it is {3,2}, indicating that 630 is a cubefree number (i.e. - having no prime factor with a greater exponent than 2).

Is it possible to do this with a range of numbers, so that Mathematica evaluates each number in this way within a range, and then outputs that list of numbers?

$\endgroup$

4 Answers 4

7
$\begingroup$
SetAttributes[cubeFreeQ, Listable]

cubeFreeQ[n_Integer] := Max@FactorInteger[n][[All, 2]] < 3

seems straightforward

To find all the cube-free numbers in the first 1000 integers, do

Select[Range[1000], cubeFreeQ]
$\endgroup$
3
  • $\begingroup$ many thanks for this. Is there any way to output a list of these - ie, to keep the numbers whose cubefree value is 'True' and delete thos from thelist that are 'False', and vice versa? $\endgroup$
    – martin
    Commented Nov 19, 2013 at 11:44
  • 1
    $\begingroup$ @martin see edit $\endgroup$
    – Aky
    Commented Nov 19, 2013 at 11:47
  • $\begingroup$ @ Aky - fantastic! - thanks :) $\endgroup$
    – martin
    Commented Nov 19, 2013 at 11:47
4
$\begingroup$

Since you asked about a solution for a "range of numbers", you could try a cube-free sieve. This differs from previous answers by not using FactorInteger. The sieve can be much faster than FactorInteger solutions when the range a to b is not too long.

cf[a_, b_] := 
   Complement[
      Range[a, b], 
      Apply[Sequence,
         Map[Range[Quotient[a,#]*#,b,#]&,Prime[Range[PrimePi[b^(1/3)]]]^3]]]
$\endgroup$
3
$\begingroup$
FreeQ[ Last @ Transpose @ FactorInteger[630], 3]
True

In general:

cubeFreeQ[n_Integer] := FreeQ[ Last @ Transpose @ FactorInteger[n], _?(# >= 3 &)]

It works like this:

cubeFreeQ /@ {113, 125, 137, 256, 193839272}
{True, False, True, False, False}

And you can select cube free numbers this way:

Cases[{15, 16, 24, 36, 48, 77, 125, 12094709274}, _?cubeFreeQ]
{15, 36, 77, 12094709274}
$\endgroup$
7
  • $\begingroup$ cubefreeQ[64] yields True yet 64 =4^3 $\endgroup$
    – ubpdqn
    Commented Nov 19, 2013 at 11:10
  • $\begingroup$ @ubpdqn No it yields False. $\endgroup$
    – Artes
    Commented Nov 19, 2013 at 11:12
  • $\begingroup$ My comment related to your general answer that did not have the inequality not the subsequent edit...no offence intended $\endgroup$
    – ubpdqn
    Commented Nov 19, 2013 at 11:14
  • $\begingroup$ @Artes i tried my own implementation and realised later that your answer is more accurate, since you even factor out the exponent (e.g. 256 which is 2^8 and 8=2^3 therefore false) to find out, if it is cube free. very decent indeed. +1 $\endgroup$
    – Stefan
    Commented Nov 19, 2013 at 11:27
  • $\begingroup$ @Stefan Thanks, I guess you mean $256 = 2^3 \cdot 32 = 4 \cdot 4^3$ etc. Another way would play with divisors, but the latter seems to be more involved. $\endgroup$
    – Artes
    Commented Nov 19, 2013 at 11:36
1
$\begingroup$
cf[u_]:= And @@ ( # < 3 & /@ FactorInteger[u][[All,2]])

yields True for cf[630] while cf[64] yields False.

$\endgroup$
2
  • $\begingroup$ @ Ubpdqn, Thanks for this. Is there any way to output a list of these - ie, to keep the numbers whose cubefree value is 'True' and delete thos from thelist that are 'False', and vice versa? $\endgroup$
    – martin
    Commented Nov 19, 2013 at 11:45
  • $\begingroup$ Select[list,cf] is one way but as you know in Mathematica there is more than one way to do things, e.g Cases, Pick etc. Setting attribute to Listable, as per Aky, would let you apply to list and then use Pick. $\endgroup$
    – ubpdqn
    Commented Nov 19, 2013 at 11:48

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.