# How to manipulate nested expressions?

I have the following expression, only slightly complicated, and I'd like to do two things:

1. Plot the elements of the lists (though messy, all are in the same range) in terms of the range of the random variable in Expectation. (0.1 in the working example)
2. Let the Plot work with Manipulate so that the user can experiment with different underlying values.

With all these SetDelayed used, I could not get Manipulate to work (Plot is simply slow). Basically, I am not sure if I can simply feed a new value for underlying into the last line (Expectation), or I need Replace, or some rule, a Block, or With?

underlying := {0.8,0.7,0.5,0.4,0.8,0.7}
DB :={disc[[2]]/disc[[1]],disc[[1]]^2/disc[[2]]}
db :={disc[[4]]/disc[[3]],disc[[3]]^2/disc[[4]]}
deltasbetas = Expectation[{disc,DB,db},{e1,e2,e3,e4,e5,e6}
\[Distributed]UniformDistribution[Table[{0,0.1},{6}]]]

(* {{0.85,0.75,0.647807,0.600891},{0.883373,0.965877},{0.931221,0.705072}} *)
-
Could you post your (non-working) Plot? – Dr. belisarius Jul 13 '12 at 17:38
@belisarius: Thanks for your code below, I tried to comment on it. – László Jul 15 '12 at 18:17

Several observations as a basis for paper-and-pencil approach which, in turn, "might" suggest the first steps of an alternative formulation working with univariate expectations:

• the components of the random vector e and, hence, those of the random vector answers are independent random variables
• the remaining random variables discs,DB db are products of independent random variables, hence their expectations are the products of the expectations of constituent RVs
• For each component of answers, we need four central moments (namely, 1,2, -1 and -2) to compute the expectations of the remaining random variables.

So, let

z[a_, e_] := Min[1, Max[a + e, 0]]
moment[a_, d_, m_Integer] :=
Expectation[z[a, e]^m, e \[Distributed] UniformDistribution[{0, d}]]

Table[{i, moment[a, d, i]}, {i, {1, 2, -1}}] // TableForm

EDIT: Using the observations above and a modification of Istvan's answer for making the legends:

expVal[a_?NumericQ, d_?NumericQ, m_?NumericQ] :=
NIntegrate[Min[1, Max[a + x, 0]]^m PDF[UniformDistribution[{0, d}], x], {x, 0, d}];

capDelta[a5_?NumericQ, a6_?NumericQ, d_?NumericQ] := expVal[a6, d, 1] expVal[a5, d, -1];

capBeta[a5_?NumericQ, a6_?NumericQ, d_?NumericQ] := expVal[a5, d, 1] expVal[a6, d, -1];

delta[a1_?NumericQ, a2_?NumericQ, a3_?NumericQ, a4_?NumericQ, d_?NumericQ] :=
expVal[a4, d, 1] expVal[a2, d, -1] expVal[a3, d, -1] expVal[a1, d, 1];

beta[a1_?NumericQ, a2_?NumericQ, a3_?NumericQ, a4_?NumericQ, d_?NumericQ] :=
expVal[a3, d, 2] expVal[a1, d, -2] expVal[a4, d, -1] expVal[a2, d, 1];

tbl[a1_?NumericQ,a2_?NumericQ,a3_?NumericQ, a4_?NumericQ,a5_?NumericQ, a6_?NumericQ] :=
Transpose[{capDelta[a5, a6, #], capBeta[a5, a6, #], delta[a1, a2, a3, a4, #],
beta[a1, a2, a3, a4, #]} & /@  Table[i, {i, .1, 1, .1}]];

labels = {"Delta", "Beta", "delta", "beta"};

Using the definitions above:

Manipulate[lp = ListPlot[tbl[a1, a2, a3, a4, a5, a6],
Joined -> True, DataRange -> {.1, 1}, PerformanceGoal -> "Speed", ImageSize -> 400];
linestyles = Cases[lp, {directive__, line_Line} :> {directive}, \[Infinity]];
Row[{lp, Grid[Table[{Graphics[Append[linestyles[[i]], Line[{{-1, 0}, {1, 0}}]],
ImageSize -> 50, AspectRatio -> 1/10], labels[[i]]}, {i, 4}],
Spacings -> 2, Alignment -> Left]}],
{{a1, .5, "a1"}, .1, 1, .1},
{{a2, .5, "a2"}, .1, 1, .1},
{{a3, .5, "a3"}, .1, 1, .1},
{{a4, .5, "a4"}, .1, 1, .1},
{{a5, .5, "a5"}, .1, 1, .1},
{{a6, .5, "a6"}, .1, 1, .1}]

screenshot:

-
Thanks again, this is great. On pen-and-paper though, I hoped to have Mathematica and esp. Manipulate as a nice environment to track how my observations would change with different errors, so it would be great if things would work numerically whatever I throw at it (non-uniform errors, correlation etc.). But thanks! – László Jul 13 '12 at 20:20

Manipulate of course works with CompoundExpression, sot the code below does what I was after. Thank you for all the help.

Manipulate[u={u1,u2,u3,u4,u5,u6};
DB={disc[[2]]/disc[[1]],disc[[1]]^2/disc[[2]]};
db={disc[[4]]/disc[[3]],disc[[3]]^2/disc[[4]]};
deltasbetas[x_]:=NExpectation[{DB,db},{e1,e2,e3,e4,e5,e6}
\[Distributed]UniformDistribution[Table[{0,x},{6}]]];
Needs["PlotLegends`"];
ListPlot[Transpose@Table[Flatten@deltasbetas[x],{x,0.01,0.51,0.05}],
Joined->True,PlotLegend-> {"Delta","Beta","delta","beta"},
{{u1,0.8},0,1,0.1},{{u2,0.7},0,1,0.1},{{u3,0.5},0,1,0.1},{{u4,0.4},0,1,0.1},
{{u5,0.8},0,1,0.1},{{u6,0.7},0,1,0.1}]

The question is: Could it be any faster, like with some Compile or parallelization?

-

Still slow, but much faster than yours:

u = {0.8, 0.7, 0.5, 0.4, 0.8, 0.7};
answers = MapThread[(Min[1, Max[#1 + #2, 0]]) &, {u, {e1, e2, e3, e4, e5,  e6}}];