4
$\begingroup$

I have the following expression:

$Q=\frac{\sqrt{rc}}{1+r(1+K)}$

Q and K are constant values. Basically I want to plot a graph that shows me all the combinations of r and c that verify the equation. Moreover I want to find the optimal pair (r,c) (basically the best compromise that minimizes both values) that allows to fulfill the condition. Any guess on how to do it in Mathematica?

Thank you!

$\endgroup$
2
  • $\begingroup$ Try q=7;k=4;FindInstance[q==Sqrt[r c]/(1+r(1+k)),{r,c},Integers,20] for your Q and K values and see how many integer solutions it finds, For the handful I tried it only seemed to find one or two solutions and could not prove there were no more. If you are not limiting this to integer values, or if q or k are not integers, then there might be other solutions. $\endgroup$
    – Bill
    May 10, 2023 at 4:45
  • $\begingroup$ Hello Bill! Yes they don't need to be integers, all these values (Q,k,r and c) are positive reals. $\endgroup$ May 10, 2023 at 4:49

2 Answers 2

3
$\begingroup$

I plead ignorance of typical values K, Q. However, this may be helpful.

Defining Q as f:

  f[r_, c_, k_] := Sqrt[r c]/(1 + r (1 + k))

Solving for (r,c) given K, Q (as c can be expressed as function of r):

 opt[a_, b_] := Quiet[Module[{w, ans, y},
       w = c /. Solve[f[r, c, a] == b, {r, c}][[1]];
       ans = r /. Solve[D[w, r] == 0 && r > 0, r][[1]];
       {ans, w} /. r -> ans
       ]]

Visualizing:

cp[k_, q_] := Module[{pts = opt[k, q]},
  ContourPlot[f[r, c, k] == q, {r, 0, 10}, {c, 0, 10}, 
   PlotLabel -> Row[{"Q=", q, ", K=", k}], 
   Epilog -> {Red, Point[pts], Text[pts, pts, {-1, 1}]}]]

Some examples:

Partition[
  Flatten[Table[cp[j, k], {j, 1, 3, 0.5}, {k, 0.1, 0.5, 0.1}]], 
  5] // Grid

Note (r,c) plane. Critical r value 1/(1+k)

enter image description here

$\endgroup$
2
$\begingroup$

For fixed values of k and q, you can plot {r,c} pairs satisfying the constraint using ContourPlot.

ClearAll[f]
f[r_, c_, k_, q_] := q - Sqrt[r c]/(1 + r + r k)

options = {ImageSize -> 500, PlotPoints -> 60, Mesh -> {{0}}, 
   MeshStyle -> Directive[Red, PointSize[Large]], AspectRatio -> 1, 
   PlotStyle -> Thick, PlotRange -> {{0, 5}, {0, 5}}};

ContourPlot[{f[r, c, 7/10, 3/5] == 0,
  f[r, c, 1/2, 2/3], 
  f[r, c, 9/10, 2/5], 
  f[r, c, 2/5, 3/5]}, 
 {r, 0, 3}, {c, 0, 10}, 
 Evaluate @ options, 
 PlotLegends -> Placed["Expressions", {Right, Top}, Style[#, 18] &]]

enter image description here

You can use Manipulate to interactively change the values of k and q.

First a few functions to help with streamlining Manipulate inputs:

ClearAll[bSF, objectiveFunctionContours, displayFunction, plots]

bSF[k_, q_] := First @ Cases[Normal @ 
    ContourPlot[f[r, c, k, q] == 0, {r, 0, 3}, {c, 0, 10}], 
    Line[x_] :> BSplineFunction[x], All];

objectiveFunctionContours[w_] := 
 ParametricPlot[# Normalize[w, Total] {t, 1 - t} & /@ Range[20], {t, 0, 1}, 
   PlotStyle -> Directive[Orange, Thickness[Small]]]

displayFunction[w_] := 
 Module[{pt = First @ Cases[Normal @ #, Point[x_] :> x, All]}, 
   Show[#, PlotLabel -> 
     Style[Row[{w . (HoldForm /@ {r, c}), 
        "  is minimized at {r, c} = ", NumberForm[pt, {∞, 3}], 
        "\n with value = ", NumberForm[w . pt, {∞, 4}]}], 16], 
    Epilog -> {Red, InfiniteLine[{pt, {0, (1/w) . pt}}]}]] &

plots[k_, q_, rcweights_ : {1, 1}] :=
 Module[{bsF = bSF[k, q],
   df = displayFunction[rcweights], 
   ofcontours = objectiveFunctionContours[rcweights]}, 
  Show[ParametricPlot[bsF[t], {t, 0, 1},
    MeshFunctions -> {(1/rcweights) . bsF'[#3] &},
    Evaluate @ options,
    DisplayFunction -> df], ofcontours]]

Problem 1: Given k, q and rw (relative weight of r in the objective function w rw + c) find {r,c} that minimizes r rw + c subject to the constraints f[r,c,k,q] == 0 && r >= 0 && c >= 0

The following Manipulate allows interactive exploration of Problem 1 showing the constraint set (where f[r,c,k,q]==0), objective function contours (orange lines), and the point (red dot) that solves the constrained minimization problem.

Manipulate[plots[k, q, {wr, 1}],
 {{k, .7}, 0, 1, Appearance -> "Labeled", LabelStyle -> 14},
 {{q, .6}, 0, 1, Appearance -> "Labeled", LabelStyle -> 14},
 {{wr, 1, "relative weight of r"}, 0, 3, Appearance -> "Labeled", 
  LabelStyle -> 14}]

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Re "the optimal pair", you need to specify a positive lower bound for the variables to avoid the trivial solution r==c==k==q==0. $\endgroup$
    – kglr
    May 10, 2023 at 7:09
  • $\begingroup$ Really cool, such minimizations really 'rock'! $\endgroup$ May 10, 2023 at 14:59

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.