0
$\begingroup$

I need help to find a value for "d" which the expr has the minimum value at that "d" value. Constraints are added to the code

ClearAll[c, x1, y1, x2, y2, d, expr]
c = 5;
expr = -x1*y1*c + x2*y2*c + d*x1*x2;
FindMinimum[{expr,
  x2*y2 + 2*c*y2 - d*x1*x2 < 0 &&
  -x1*y1 + 2*c*y1 - d*x1*x2 < 0 && 
  x1 + x2 == 1 &&
  y1 + y2 == 1 && 
  x1 > 0 && 
  x2 > 0 && 
  y1 >= 0 &&
  y2 >= 0}, {d}]

The code above doesn't give me any values for "d" and I don't get any errors. I don't know what the problem is with this code.

Improve this question
$\endgroup$

3 Answers 3

Reset to default
0
$\begingroup$

To minimize symbolically,Minimize works here.

ClearAll[c, x1, y1, x2, y2, d, expr]
c = 5;
expr = -x1*y1*c + x2*y2*c + d*x1*x2;
Minimize[{expr, 
  x2*y2 + 2*c*y2 - d*x1*x2 < 0 && -x1*y1 + 2*c*y1 - d*x1*x2 < 0 && 
   x1 + x2 == 1 && y1 + y2 == 1 && x1 > 0 && x2 > 0 && y1 >= 0 && 
   y2 >= 0}, {d}]

Mathematica graphics

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ This indicates that d is Indeterminate $\endgroup$ Commented Dec 30, 2019 at 18:49
  • $\begingroup$ Hi @Xminer thanks for your help. The code you provided works. -@BobHanlon you are right "d" is Inderterminate and I need to give initial values for x1, x2, y1 and, y2. $\endgroup$ Commented Dec 30, 2019 at 19:49
1
$\begingroup$ 
ClearAll["Global`*"]

c = 5;

Eliminate unnecessary variables {x2, y2}

expr = -x1*y1*c + x2*y2*c + d*x1*x2 /. {x2 -> 1 - x1, y2 -> 1 - y1} // 
  Simplify

(* 5 + (-5 + d) x1 - d x1^2 - 5 y1 *)

var = Variables[Level[expr, {-1}]];

cons = x2*y2 + 2*c*y2 - d*x1*x2 < 0 && -x1*y1 + 2*c*y1 - d*x1*x2 < 0 && 
     1 > x1 > 0 && 1 >= y1 >= 0 /. {x2 -> 1 - x1, y2 -> 1 - y1} // Simplify;

min = FindMinimum[Evaluate[List @@ (expr && cons)], var, 
  WorkingPrecision -> 15]

(* {2.10526275527238, {d -> 1.46032188433906*10^7, x1 -> 0.999999675630191, 
  y1 -> 0.526316126809388}} *)

expr /. min[[2]]

(* 2.1052628 *)
Improve this answer
$\endgroup$
4
  • $\begingroup$ Hi @Bob Hanlon, I ran your code and I get different value for "d" following is the results that I get: {2.10535857973380, {d -> 269407.8237226680, x1 -> 0.999982417241665, y1 -> 0.5263157407680821}} $\endgroup$ Commented Dec 30, 2019 at 20:02
  • $\begingroup$ I copied, pasted, and executed the code above and got the results as shown above. I am using version 12.0 on macOS 10.15.2 $\endgroup$ Commented Dec 30, 2019 at 20:10
  • $\begingroup$ still I get the same results, {2.10535857973380, {d -> 269407.8237226680, x1 -> 0.999982417241665, y1 -> 0.5263157407680821}}. I am using version 8 of Mathematica $\endgroup$ Commented Dec 30, 2019 at 20:42
  • $\begingroup$ Version 8 is pretty old. Perhaps you are using a 32-bit version rather than 64-bit. The minimum appears to occur as d grows unbounded so any small deviation in {x1, y1} would cause large changes in d. $\endgroup$ Commented Dec 30, 2019 at 22:10
1
$\begingroup$

With variable substitution d -> 1/dd (together with the variable elimination by @Bob Hanlon) you can easily get an analytical solution (for values at the boundary).

c = 5;

expr = -x1*y1*c + x2*y2*c + d*x1*x2 /. {x2 -> 1 - x1, y2 -> 1 - y1} //
Simplify

cons = x2*y2 + 2*c*y2 - d*x1*x2 < 0 && -x1*y1 + 2*c*y1 - d*x1*x2 < 0 &&
 1 > x1 > 0 && 1 >= y1 >= 0 /. {x2 -> 1 - x1, y2 -> 1 - y1} // 
Simplify

mi = Minimize[{expr, cons} /. d -> 1/dd, {dd, x1, y1}, Reals]

(*   Minimize::wksol: Warning: There is no minimum in the region in which the objective function is defined and the constraints are satisfied; returning a result on the boundary. >>   *)

(*   {40/19, {dd -> 0, x1 -> 1, y1 -> 10/19}}   *)
Improve this answer
$\endgroup$
3
  • $\begingroup$ Hi @Akku14 the code works. Thank you. Is there a way to have contour plot to show the minimum values of d for different values of x1 and y1 on two axises? $\endgroup$ Commented Jan 2, 2020 at 16:09
  • $\begingroup$ The minimal allowed d for certain x1,y1 according to cons? mind = Minimize[{d, cons}, {d}, Reals] Absolute allowed min of d mindabs = Minimize[{d, cons}, {d, x1, y1}, Reals] // N . gr = Graphics3D[{PointSize[Large], Red, Point[{x1, y1, d} /. mindabs[[2]]]}]; pl = Plot3D[mind[[1]], {x1, 0, 1}, {y1, 0, 1}, PlotPoints -> 100 ]; cp = ContourPlot[mind[[1]], {x1, 0, 1}, {y1, 0, 1}, Contours -> {21, 40, 60, 80, 100}, ContourShading -> None, MaxRecursion -> 3, Epilog -> {PointSize[Large], Red, Point[{x1, y1} /. mindabs[[2]]]}] Show[pl, gr] . $\endgroup$ Commented Jan 3, 2020 at 6:44
  • $\begingroup$ Get the minimum of expr for all possible d mimi = Minimize[{expr, cons}, {d}, Reals] Plot3D[mimi[[1]], {x1, 0, 1}, {y1, 0, 1}] and the known overall minimum Minimize[mimi[[1, 1, 1]], {x1, y1}, Reals] $\endgroup$ Commented Jan 3, 2020 at 7:06

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.