Problems Computing (in a reasonable amount of time) Solutions to a System of Inequalities

Question

For my Cryptography research I am interested in finding solutions to the following inequalities in terms of $r$ and $s$, where $p$ is some fixed constant.

$$\begin{align} 2^{p - s + 4} + 2^{p - r} + 2^{p - r - s + 4} + 13/4 < 2^{p - 8} \\ 2^{p - r + 4} + 2^{p - s + 8} + 2^{p - r - s + 8} + 13/4 < 2^{p - 4} \end{align}$$

I have tried the following computation:

Solve[2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 2^(p - 8) && 
2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 2^(p - 4), {r, s}]

Unfortunately, it is taking forever to compute (literally days), so does anyone have any ideas?

Thanks!

Answer 1

Let's start by seeing if there is a solution at all.

conds = 2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 2^(p - 8) &&
        2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 2^(p - 4)
FindInstance[ conds, {p, r, s}, Integers]
(* {{p->84, r->164, s->92}} *)

Ok, that looks nice, there is at least one solution. We can visualize the solution space including the solution FindInstance found with

RegionPlot3D[conds, {p, 0, 200}, {r, 0, 200}, {s, 0, 200}, AxesLabel -> {p, r, s}]

Ok, it looks there are hard lower limits for each parameter and a soft transition between those planes. We can have a look at that interesting part.

RegionPlot3D[conds, {p, 7, 20}, {r, 7, 20}, {s, 7, 20}, AxesLabel -> {p, r, s}]

Now to get some quantifiable lower limits, we can make it easier for Reduce by working with 2 to the power of p,r,s instead of the parameters themselves.

powconds = conds /. Thread[{p, r, s} -> Log[2, {pp, pr, ps}]]

Reduce[powconds, {pp, pr, ps}, Integers] still takes forever so let's constrain pp,pr,ps to be positive.

pospowconds = powconds && And @@ Thread[{pp, pr, ps} > 0]

Now

reducedconds = Reduce[pospowconds, {pp, pr, ps}]

is able to find a nice reduction

that we can transform back to our original parameters

newconds = reducedconds /. Thread[{pp, pr, ps} -> 2^{p, r, s}]

or in terms of p,r,s that is

newconds /. Greater[a_, b_] -> Greater[Log[2, a], Log[2, b]] // PowerExpand

So now we have a lower limit for p. Are there lower limits for r and s, too? Let's go back to the reduced power conditions and ask the question in terms of quantifiers

questions =  MapThread[ 
    Exists[#1, ForAll[{pp, pr, ps}, reducedconds, #2 > #1]] &,
    {{lowerpr, lowerps}, {pr, ps}}
  ]

and let Mathematica resolve the questions for us

Resolve /@ questions
(* {True, True} *)

So there are lower limits for r and s, too. Nice! Since we're lazy we let Mathematica do the work of finding the highest lower limit for which the conditions are still satisfied:

VariableGreaterThan[var_, threshold_] := Resolve[
    ForAll[{pp, pr, ps}, reducedconds, var > threshold]
  ]
lowerpowerlimits = FindMaxValue[
    {th, VariableGreaterThan[#, th] \[And] th \[Element] Integers},
    {th, 1}
  ] & /@ {pp, pr, ps}
(* 832., 256., 4096. *)

so the lower limits of p, r, s are

lowerlimits = Log[2, lowerpowerlimits]
(* {9.70044, 8., 12.} *)

Our plot of the solution space from above with the new tight bounds

RegionPlot3D[
    conds,
    {p, #1, #1 + 10}, {r, #2, #2 + 10}, {s, #3, #3 + 10}, 
    AxesLabel -> {p, r, s}
  ] & @@ lowerlimits

Answer 2

Just to clarify, you keep mentioning speed, but there is no issue with speed, but fundamental solvability. Both of this formulation will almost momentarily report about solvability impasse:

eq = 2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 
   2^(p - 8) && 2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 
   2^(p - 4); eq // TraditionalForm

Solve[eq, {r, s}, Reals]

Reduce[eq, {r, s}, Reals]

So, to reiterate, this is not the issue of time, but solvability. You should always try to tweak your problem to make it solvable. For example set some numerical values for some parameters and see if solution makes sense. Following the @belisarius advice in the comments, try specific instances:

FindInstance[2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 2^(p - 8) && 
  2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 
   2^(p - 4) && p == 256 && 0 < r <= s, {p, r, s}, Reals, 10]

Or Try visualization:

RegionPlot3D[eq, {p, 10, 15}, {r, 9, 10}, {s, 13, 15}, Mesh -> 8, 
 MeshFunctions -> {Function[{x, y, z}, Norm[{x, y, z}]]}, 
 MeshShading -> {Directive[Yellow, Opacity[0.4]], FaceForm[Cyan, Red]}]

Answer 3

FindInstance may give us many solutions but no information on the solution space. So this is not a very welcome approach. Therefore we would rather like bounds for p,r,s working with Reduce.

We get rid of 2^p, 2^r, 2^s changing them respectively to x, y, z.

ineq= 2^(p - s + 4) + 2^(p - r) + 2^(p - r - s + 4) + 13/4 < 2^(p - 8) && 
      2^(p - r + 4) + 2^(p - s + 8) + 2^(p - r - s + 8) + 13/4 < 2^(p - 4)

ineq1 = ineq /. Thread[ {p, r, s} -> Log2 @ {x, y, z}]

 13/4 + x/y + (16 x)/z + (16 x)/(y z) < x/256 && 
 13/4 + (16 x)/y + (256 x)/z + (256 x)/(y z) < x/16

and we solve the inequalities with respect to y , z assuming them to be real and positive :

Reduce[ ineq1 && y > 0 && z > 0 && x > 0, {y, z}, Reals]

 x > 832 && y > (256 x)/(-832 + x) && z > (4096 x + 4096 x y)/(-256 x - 832 y + x y)

To proceed further we can do this

x > 832 && y > (256 x)/(-832 + x) &&
z > (4096 x + 4096 x y)/(-256 x - 832 y + x y) /. {x -> 2^p, y -> 2^r, z -> 2^s}

2^p > 832 && 2^r > 2^(8 + p)/(-832 + 2^p) &&
2^s > (2^(12 + p) + 2^(12 + p + r))/(-2^(8 + p) - 13 2^(6 + r) + 2^(p + r))

Instead of putting this output to Reduce and getting

Reduce::nsmet: This system cannot be solved with the methods available to Reduce. >>

we'll do this :

Reduce[2^p > 832, p, Reals]

p > (6 Log[2] + Log[13])/Log[2]

or

Reduce[2^p > 832, p, Integers]

p ∈ Integers && p >= 10

(6 Log[2] + Log[13])/Log[2] // N

9.70044

Next e.g. we can find bounds for r and s assuming values of p :

Reduce[p == # && 2^r > 2^(8 + p)/(-832 + 2^p) && 
       2^s > (2^(12 + p) + 2^(12 + p + r))/(-2^(8 + p) - 13 2^(6 + r) + 2^(p + r)),   
       {r, s}, Reals] & /@ Range[10, 13] 

If we assume the domain of r ,s to be Integers that will lead to this message Reduce::nsmet: ....

RegionPlot3D[ineq, {p, 8, 15}, {r, 8, 15}, {s, 11, 15}, Mesh -> 4, MeshFunctions -> {#1 &}, 
             PlotStyle -> Directive[ Specularity[0.3], Opacity[0.3], FaceForm[ Blue, Green]]]