find the min and max of the set of prime factor of a number with the same power in Mathematica

Question

Let

n=2^10 3^7 5^4...31^2...59^2 61...97

be the factorization of an integer such that the powers of primes are non-increasing.

I would like to write a code in Mathematica to find Min and Max of prime factor of n such that they have the same power. for example I want a function which take r(the power) and give (at most two) primes in general. A specific answer for the above sample is

minwithpower[7]=3

maxwithpower[7]=3

---

minwithpower[2]=31

maxwithpower[2]=59

Any idea please.

Answer 1

Let n = 91065388654697452410240000 then

FactorInteger[n]

returns

{{2, 10}, {3, 7}, {5, 4}, {7, 4}, {31, 2}, {37, 2}, {59, 2}, {61, 1}, {97, 1}}

and the expression

Cases[FactorInteger[n], {_, 2}]

returns only those elements from the list of factors and coefficients where the coefficient is 2, ie

{{31, 2}, {37, 2}, {59, 2}}

Next, the expression

Cases[FactorInteger[n], {_, 2}] /. {{min_, _}, ___, {max_, _}} -> {min, max}

returns

{31, 59}

Note that this approach fails if the power you are interested in only occurs once in the output from FactorInteger, for example

Cases[FactorInteger[n], {_, 7}] /. {{min_, _}, ___, {max_, _}} -> {min, max}

returns

{{3, 7}}

but you should be able to fix that deficiency quite easily.

Answer 2

One solution is :

getSamePower[exp_, n_] :=  With[{powers = 
 Select[ReleaseHold[n /. {Times -> List, Power[a_, b_] -> {a, b}}], #[[2]] == 
   exp &]}, 
  If[Length[powers] == 1, {powers[[1, 1]], powers[[1, 1]]}, {Min[powers[[All, 1]]], Max[powers[[All, 1]]]}]]

to be used as :

getSamePower[7,  2^10 3^7 5^4 \[Pi]^1 31^2 E^1 59^2 61^1 I^1 97^1 // HoldForm]
(* {3, 3} *)

getSamePower[2,  2^10 3^7 5^4 \[Pi]^1 31^2 E^1 59^2 61^1 I^1 97^1 // HoldForm]
(* {31, 59} *)