Sheldon Ross 10: Exercise 3.13

Question: Let X be exponential with mean 1λ that is, fX(x) = λe−λx  : 0< x < ∞. Find E[X|X > 1]


Analytical Solution

The approach for this is blunt and easy. Follow the steps as outlined below

  • Find the conditional density of the distribution which would be fX(x)1-FX(x=1)
    • When simplified, the denominator is e−λ
  • Finally, integrate the conditional density over x’s domain which is here 1 through ∞
    • When integrated, we get the probability as 1 + 1λ

Simulation Solution

This would a fairly simple idea to simulate. Simply follow the following steps to make your own algorithm. I have also presented my results and the code that was used.

  • Pick a reasonable λ  (as in 0 < λ < ∞)
  • Use this to generate a bunch of exponential random variables
  • Filter this list to select the numbers that are greater than 1 (this being the requirement from the question)
  •  Calculate the mean of filtered list
  • Plot this data as you like !!
  • Data generated using the approach is presented as a custom plot below.
  • Observations
    • Note how the simulation is fluctuating around the theoretical mean
    • Also see that the variance increases as the λ increases
      • This is because as the λ increases, it becomes more difficult to find the values that are greater than 1
      • Understandably, this is because of the fact that the as the rate increases, the the random numbers generated by such an exponential process would have lower times ( or time intervals )


Code

I used Mathematica for the data creation and visualization. The code is given below. Please drop a comment if you have any questions. The first block of the code is the custom function that I am loading from the library utilities`

stringJoinStyled[items_List, buffer_ : ""] := Apply[StringJoin, ToString[#, StandardForm] & /@ Riffle[items, buffer]]

AppendTo[$Path, "D:\\Mathematica Files 4K\\mathematicaPackages"];
Needs["utilities`"];

ClearAll[NumberQSelect]
NumberQSelect[list_List] :=
    Select[list, And @@ {NumberQ[#[[1]]], NumberQ[#[[2]]]} &]
ListLinePlot[
  Table[NumberQSelect[
    Table[{r,
      Mean[Select[
        RandomVariate[ExponentialDistribution[r],
          1000], # > 1 &]]}, {r, 1, 5, 0.1}]], {t, 200}] ~
      Join ~ {{#, 1 + Divide[1, #]} & /@ Range[1, 5, 0.1]},
  InterpolationOrder -> 2, Joined -> True,
  PlotStyle -> (({Opacity@0.1, Darker@Green, Thickness@0} & /@
      Range[200]) ~ Join ~ {{Dashed, Black, Thick}}), Frame -> True,
  ImageSize -> 788, AspectRatio -> 1, PlotRange -> {{0, 5}, {0, 2.5}},
  PlotLegends -> {utilities`stringJoinStyled[{Style["---", Black],
    " Theory"}],
    utilities`stringJoinStyled[{Style["---", Darker@Green],
      " Simulation"}]},
  FrameLabel -> (Style[#, 16] & /@ {"\[Lambda]",
    "E[ X|X>1,\[Lambda] ]"})]

End of the post 😀


.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.