5
$\begingroup$

Given:

Clear[\[Gamma], r];
ineq = r[3] + \[Gamma] r[4] > r[2] + \[Gamma] r[3] && r[2] + \[Gamma] (r[3] + r[5]) < r[3] + \[Gamma] (r[2] + r[4]);
reg = ImplicitRegion[ ineq, {{r[1], 0, 1}, {r[2], 0, 1}, {r[3], 0, 1}, {r[4], 0, 
 1}, {r[5], 0, 1}}];
Integrate[1, {r[1], r[2], r[3], r[4], r[5]} \[Element] reg, Assumptions -> {1 > \[Gamma] > 0}] // AbsoluteTiming

enter image description here

I would like to speed up the computation if possible. Current Thoughts:

1.Remove unnecessary conditions: As far as I can tell, all of the piecewise conditions are unnecessary except the one corresponding to True. Using Simplify[] removes some of them, but that function is applied after the fact; not affecting the time.

2.Adding Assumptions: Gamma and r[n] are all Real and between 0 and 1. Adding any combination to Assumptions like:

$Assumptions = {0 < \[Gamma] < 1, \[Gamma] \[Element] Reals,   r[1] \[Element] Reals, r[2] \[Element] Reals,   r[3] \[Element] Reals, r[4] \[Element] Reals, r[5] \[Element] Reals}

, produces no affect on timing or the output. Another assumption is that I'm integrating over a specific region of a hypercube of n-volume = 1, though I don't know how to include this usefully.

3.Integrating without ImplicitRegion[]: I'm using this function since it allows plugging in any inequality, and it returns the region of the hypercube I'm interested in. There may be a faster way to integrate over a hypercube given an inequality, but I am not aware of it.

$\endgroup$
  • $\begingroup$ The default value (corresponding to True) is only valid for one value ({\[Gamma] -> (1/2)*(3 - Sqrt[5])}) in the interval {0, 1}. $\endgroup$ – Bob Hanlon Oct 14 at 21:25
  • $\begingroup$ How did you determine that? $\endgroup$ – Logan Smith Oct 14 at 22:08
  • $\begingroup$ See extended comment. $\endgroup$ – Bob Hanlon Oct 14 at 23:14
4
$\begingroup$

This is an extended comment to address the conditions for which the default in the Piecewise applies:

Clear["Global`*"];

ineq = r[3] + γ r[4] > r[2] + γ r[3] && 
   r[2] + γ (r[3] + r[5]) < r[3] + γ (r[2] + r[4]);

reg = ImplicitRegion[
   ineq, {{r[1], 0, 1}, {r[2], 0, 1}, {r[3], 0, 1}, {r[4], 0, 1}, {r[5], 0, 
     1}}];

(int[γ_] = Assuming[1 > γ > 0, Integrate[1,
      {r[1], r[2], r[3], r[4], r[5]} ∈ reg] //
     Simplify]) // AbsoluteTiming

enter image description here

The three functions are

funcs = {int[γ][[1, 1, 1]], int[γ][[1, 2, 1]], 
  int[γ][[2]]}

(* {(-1 + 6 γ + γ^2 + 2 γ^4)/(24 γ^2), (
 12 - 28 γ + 19 γ^2 - 4 γ^3 + 2 γ^4)/(
 24 (-1 + γ)^2), -((-1 + 11 γ - 35 γ^2 + 81 γ^3 - 
   95 γ^4 + 45 γ^5 - 11 γ^6 + γ^7)/(
  24 (-1 + γ) γ^2))} *)

From the conditions specified in the Piecewise, the default value only applies for a single value in the interval {0, 1}

Simplify[ ! 2*γ >= 1 && 
        ! (Sqrt[5] + 2*γ < 3 || 
            (Sqrt[5] + 2*γ > 3 && 
               2*γ < 1))]

(* Sqrt[5] + 2 γ == 3 *)

sol = Solve[%, γ][[1]]

(* {γ -> 1/2 (3 - Sqrt[5])} *)

The first two functions are piecewise continuous at γ == 1/2

Equal @@ funcs[[1 ;; 2]] /. γ -> 1/2

(* True *)

The third (default) function is piecewise continuous with the second function at γ == (3 - Sqrt[5])/2

Equal @@ funcs[[2 ;; 3]] /. γ -> (3 - Sqrt[5])/2 // Simplify

(* True *)

Looking at the individual components:

Show[
 Plot[funcs[[1]], {γ, 1/2, 1},
  PlotStyle -> {{Thick, ColorData[97][1]}}],
 Plot[funcs[[2]], {γ, 0, 1/2},
  PlotStyle -> {{Thick, ColorData[97][2]}}],
 Plot[funcs[[3]], {γ, 0, 1},
  PlotStyle -> {{Dashed, Lighter@ColorData[97][3]}}],
 PlotRange -> {{0, 1}, {int[1], int[0]}},
 Epilog -> {Red, AbsolutePointSize[4],
   Point[{γ, int[γ]} /. sol]}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.