Re: Mathematica results different on different computers !

• To: mathgroup at smc.vnet.net
• Subject: [mg125565] Re: Mathematica results different on different computers !
• From: Nabeel Butt <nabeel.butt at gmail.com>
• Date: Mon, 19 Mar 2012 04:56:13 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <201203180740.CAA14090@smc.vnet.net>

```Hi Ralph...
Much appreciated ! I could send u some manuscripts later if you are
interested in this area.Just to make sure you are running exactly the same
code as me-I slightly increased number of simulations -repeated re-runs
usually give the same output on a particular computer but it changes from
computer to computer - something to do with version  number because my
laptop with version 8.0.1. is giving the correct expected results.Could you
re-run the following code :
\[Lambda] = 0.05;
\[Mu] = 0.05;
T = 1;
nn = 4;
\[CapitalDelta]T = T/nn;
m1 = 0.08;
\[Sigma]1 = 0.2;
m2 = 0.14;
\[Sigma]2 = 0.8;
\[Rho] = 0.1;
mean1 = (m1 - (\[Sigma]1^2)/2)*\[CapitalDelta]T;
var1 = (\[Sigma]1^2)*\[CapitalDelta]T;
rmean1 = E^(mean1 + 1/2 var1);
rvar1 = ((E^var1 - 1) E^(2*mean1 + var1));
mean2 = (m2 - (\[Sigma]2^2)/2)*\[CapitalDelta]T;
var2 = (\[Sigma]2^2)*\[CapitalDelta]T;
rmean2 = E^(mean2 + 1/2 var2);
rvar2 = ((E^var2 - 1) E^(2*mean2 + var2));
b1 = {rk1l = 0.001, rk1u = (rmean1 + 5*Sqrt[rvar1])};
b2 = {rk2l = 0.001, rk2u = (rmean2 + 5*Sqrt[rvar2])};

dl = (rk1u - rk1l)/Num;
dk = (rk2u - rk2l)/Num;
\[ScriptCapitalD] =
TransformedDistribution[
Exp[ {u, v}], {u, v} \[Distributed]
MultinormalDistribution[{(m1 - (\[Sigma]1^2)/
2)*\[CapitalDelta]T, (m2 - (\[Sigma]2^2)/
2)*\[CapitalDelta]T}, {{\[Sigma]1^2*\[CapitalDelta]T, \
\[Rho]*\[Sigma]1*\[Sigma]2*\[CapitalDelta]T}, {\[Rho]*\[Sigma]1*\
\[Sigma]2*\[CapitalDelta]T, \[Sigma]2^2*\[CapitalDelta]T}}]];
data = Parallelize[RandomVariate[\[ScriptCapitalD], 10^6]];
ParallelEvaluate[data];

bndry3[Num_, data_] :=
Module[{UU, M, \[Lambda], \[Mu], \[CapitalDelta]T, s, m, \[Sigma],
mean, var, rmean, rvar, rkl, rku, dr, ddist, rvals, pvals, amin,
amax, da, tlist, JN, some, blist, tlist1, tlist2, sol1, sol2,
templist, l, points, pu, pl, dp, a, b, c, zi, Nm, Nz, Na, zW,
m1, \[Sigma]1, m2, \[Sigma]2, \[Rho], mean1, var1, rmean1, rvar1,
mean2, var2, rmean2, rvar2, b1, b2, dl, dk, xvals, yvals, rk1l,
rk1u, rk2l, rk2u, \[ScriptCapitalD]1, dist, \[ScriptCapitalD],
prob, JJ},

Off[InterpolatingFunction::dmval];
sll[ll_, elem_] := ll[[Ordering[ll[[All, elem]]]]];
M = 0.5;
\[Lambda] = 0.05;
\[Mu] = 0.05;
\[CapitalDelta]T = T/nn;
s = E^(0.05*\[CapitalDelta]T);
m1 = 0.08;
\[Sigma]1 = 0.2;
m2 = 0.14;
\[Sigma]2 = 0.8;
\[Rho] = 0.1;
UU = 7;
mean1 = (m1 - (\[Sigma]1^2)/2)*\[CapitalDelta]T;
var1 = (\[Sigma]1^2)*\[CapitalDelta]T;
rmean1 = E^(mean1 + 1/2 var1);
rvar1 = ((E^var1 - 1) E^(2*mean1 + var1));
mean2 = (m2 - (\[Sigma]2^2)/2)*\[CapitalDelta]T;
var2 = (\[Sigma]2^2)*\[CapitalDelta]T;
rmean2 = E^(mean2 + 1/2 var2);
rvar2 = ((E^var2 - 1) E^(2*mean2 + var2));
b1 = {rk1l = 0.001, rk1u = (rmean1 + 5*Sqrt[rvar1])};
b2 = {rk2l = 0.001, rk2u = (rmean2 + 5*Sqrt[rvar2])};

dl = (rk1u - rk1l)/Num;
dk = (rk2u - rk2l)/Num;
\[ScriptCapitalD] =
TransformedDistribution[
Exp[ {u, v}], {u, v} \[Distributed]
MultinormalDistribution[{(m1 - (\[Sigma]1^2)/
2)*\[CapitalDelta]T, (m2 - (\[Sigma]2^2)/
2)*\[CapitalDelta]T}, {{\[Sigma]1^2*\[CapitalDelta]T, \
\[Rho]*\[Sigma]1*\[Sigma]2*\[CapitalDelta]T}, {\[Rho]*\[Sigma]1*\
\[Sigma]2*\[CapitalDelta]T, \[Sigma]2^2*\[CapitalDelta]T}}]];

\[ScriptCapitalD]1 = SmoothKernelDistribution[data];

g[x_, y_] := Evaluate[CDF[\[ScriptCapitalD]1, {x, y}]];

fx1[r_] := PDF[LogNormalDistribution[mean1, Sqrt[var1]], r];
fx2[r_] := CDF[LogNormalDistribution[mean1, Sqrt[var1]], r];
pu = 1;
pl = 0;
dp = (pu - pl)/Num;
gx1[p_] := InverseCDF[LogNormalDistribution[mean1, Sqrt[var1]], p];
xvals =
Flatten[{rk1l, Table[gx1[i + dp], {i, pl, pu - 2*dp, dp}], rk1u}];

fy1[r_] := PDF[LogNormalDistribution[mean2, Sqrt[var2]], r];
fy2[r_] := CDF[LogNormalDistribution[mean2, Sqrt[var2]], r];
pu = 1;
pl = 0;
dp = (pu - pl)/Num;
gy1[p_] := InverseCDF[LogNormalDistribution[mean2, Sqrt[var2]], p];
yvals =
Flatten[{rk2l, Table[gy1[i + dp], {i, pl, pu - 2*dp, dp}], rk2u}];

f[x_, y_] := Evaluate[PDF[\[ScriptCapitalD]1, {x, y}]];

dist =
Flatten[Table[{prob = (NIntegrate[

f[x, y], {x, xvals[[i]], xvals[[i + 1]]}, {y, yvals[[j]],
yvals[[j + 1]]}, AccuracyGoal -> 4]); {NIntegrate[
x*(f[x, y])/prob
, {x, xvals[[i]], xvals[[i + 1]]}, {y, yvals[[j]],
yvals[[j + 1]]}, AccuracyGoal -> 4],
NIntegrate[
y*(f[x, y])/(prob), {x, xvals[[i]], xvals[[i + 1]]}, {y,
yvals[[j]], yvals[[j + 1]]}, AccuracyGoal -> 4]},

prob}, {i, 1, Num}, {j, 1, Num}], 1];

amin = N[0.001];
amax = N[0.999];
da = 0.01;

(*dist/.{{x_Real,y_Real},z_Real}->x+y+z*)
tlist1 = Parallelize[ParallelEvaluate[
Off[FindMinimum::reged]];
ParallelEvaluate[Off[FindMaximum::lstol]]; Table[{a,
{l =
Max[templist = {(sol1 = Flatten[Last[NestList[{{#[[1, 1]]/2},

Reverse[
Last[sll[
Flatten[
Table[{{\[Xi]}, (Total[(dist /. {{r_Real, S_Real},
p_Real} -> (Log[(S + \[Xi] (r -
S) + \[Mu] (\[Xi] - a) S)]*p))])}, {\[Xi],
If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
0, (#[[2, 2, 1]] - 2*#[[1, 1]]), 0],
If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <=
a, (#[[2, 2, 1]] + 2*#[[1, 1]]), a], #[[1, 1]]}],
0], 2]]]} & ,
{{a/4}, {-100, {a/2}}}, UU]][[2]]])[[
1]], (sol2 = Flatten[Last[NestList[{{#[[1, 1]]/2},

Reverse[
Last[sll[
Flatten[
Table[{{\[Xi]}, (Total[
dist /. {{r_Real, S_Real},
p_Real} -> (Log[(S + \[Xi] (r -
S) - \[Lambda] (\[Xi] - a) S)]*p)])}, {\[Xi],
If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
a, (#[[2, 2, 1]] - 2*#[[1, 1]]), a],
If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <= (
1 + a*\[Lambda])/(
1 + \[Lambda]), (#[[2, 2, 1]] + 2*#[[1, 1]]), (
1 + a*\[Lambda])/(1 + \[Lambda])], #[[1, 1]]}],
0], 2]]]} & ,
{{0.25*((1 + a*\[Lambda])/(1 + \[Lambda]) -
a)}, {-100, {0.5*(a + (1 + a*\[Lambda])/(
1 + \[Lambda]))}}}, UU]][[2]]])[[1]],
Total[dist /. {{r_Real, S_Real}, p_Real} ->
Log[(S + a (r - S))]*p]}],
If[templist[[3]] == l, 3,
Flatten[Position[templist, l]][[1]]],
Piecewise[{{0, templist[[3]] == l}, {sol1[[2]],
templist[[1]] == l}, {sol2[[2]],
templist[[2]] == l}}]}}, {a, amin, amax, da}]];
(*points=Select[tlist,#[[2,2]]==3&]/.{a_,{J_,
I_,\[CapitalDelta]_}}->a
Graphics[Point[points],Axes->True]*)
(*points=Select[Flatten[templist/.{{x_,y_},{z_,w_}}->{{x,y},{w}},
1],#[[2]][[1]]==3&]/.{{x_,y_},{w_}}->{x,y};*)
(*points=Select[tlist,#[[2,2]]==3&]/.{x_,{z_,w_}}->x;
points*)
JN = Interpolation[tlist1 /. {x_, {z_, w_, y_}} -> {x, z}];
(*PN=Interpolation[tlist/.{x_,{z_,w_,y_}}->{x,y}];*)
(*Off[InterpolatingFunction::dmval];*)
(*Plot[JN[x],{x,0,1}]*)
some = NestList[(JJ = #[[2]]; {tlist = Parallelize[ParallelEvaluate[
Off[FindMinimum::reged]];
ParallelEvaluate[Off[FindMaximum::lstol]];
ParallelEvaluate[Off[InterpolatingFunction::dmval]];
Table[(*nlist=(#[[1]]/.{x_,{z_,w_,y_}}->y);*){a,
{l =
Max[templist = {(sol1 =
Flatten[Last[NestList[{{#[[1, 1]]/2},

Reverse[
Last[sll[
Flatten[
Table[{{\[Xi]}, (Total[
dist /. {{r_Real, S_Real},
p_Real} -> (((Log[(S + \[Xi] (r -
S) + \[Mu] (\[Xi] - a) S)] +
JJ[(\[Xi]*
r)/(S + \[Xi] (r - S) + \[Mu] (\[Xi] - a) S)])*
p))])}, {\[Xi],
If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
0, (#[[2, 2, 1]] - 2*#[[1, 1]]), 0],
If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <=
a, (#[[2, 2, 1]] + 2*#[[1, 1]]), a], #[[1, 1]]}],
0], 2]]]} & ,
{{a/4}, {-100, {a/2}}}, UU]][[2]]])[[
1]], (sol2 = Flatten[Last[NestList[{{#[[1, 1]]/2},

Reverse[
Last[sll[
Flatten[
Table[{{\[Xi]}, (Total[
dist /. {{r_Real, S_Real},
p_Real} -> ((Log[(S + \[Xi] (r -
S) - \[Lambda] (\[Xi] - a) S)] +
JJ[(\[Xi]*
r)/(S + \[Xi] (r - S) - \[Lambda] (\[Xi] -
a) S)])*p)])}, {\[Xi],
If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
a, (#[[2, 2, 1]] - 2*#[[1, 1]]), a],
If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <= (
1 + a*\[Lambda])/(
1 + \[Lambda]), (#[[2, 2, 1]] + 2*#[[1, 1]]), (
1 + a*\[Lambda])/(1 + \[Lambda])], #[[1, 1]]}],
0], 2]]]} & ,
{{0.25*((1 + a*\[Lambda])/(1 + \[Lambda]) -
a)}, {-100, {0.5*(a + (1 + a*\[Lambda])/(
1 + \[Lambda]))}}}, UU]][[2]]])[[1]],

Total[dist /. {{r_Real, S_Real},
p_Real} -> (Log[(S + a (r - S))] +
JJ[(a*r)/(a*r + (1 - a) S)])*p]}],
If[templist[[3]] == l, 3,
Flatten[Position[templist, l]][[1]]],
Piecewise[{{0, templist[[3]] == l}, {sol1[[2]],
templist[[1]] == l}, {sol2[[2]],
templist[[2]] == l}}]}}, {a, amin, amax, da}]],
Interpolation[
tlist /. {x_, {z_, w_, y_}} -> {x, z}]}) &, {tlist1, JN},
nn - 1]];
________________________________________________________________________________
<http://t2.gstatic.com/images?q=tbn:ANd9GcRd4WJa3qO12skxxSAppQ9HimoQsMP5o--uCIe7yxZahJqlkN4z>
"We have not succeeded in answering all our problems.The answers we have
found only serve to raise a whole set of new questions.In some ways we feel
that we are as confused as ever,but we believe we are confused on a higher
level and about more important things!! Haha"
"One day we  definitely get to see all the beauty present in this world
!!!"
"Life can only be understood going backwards but it must be lived going
forwards!"
________________________________________________________________________________
THIS MESSAGE IS ONLY INTENDED FOR THE USE OF THE INTENDED
RECIPIENT(S) AND MAY CONTAIN INFORMATION THAT IS PRIVILEGED,
PROPRIETARY AND/OR CONFIDENTIAL. If you are not the intended
recipient, you are hereby notified that any review, retransmission,
dissemination, distribution, copying, conversion to hard copy or
other use of this communication is strictly prohibited. If you are
not the intended recipient and have received this message in error,
please notify me by return e-mail and delete this message from your
system. Nabeel Butt Inc.

Nabeel Butt
UWO,London

On Sun, Mar 18, 2012 at 2:39 PM, Ralph Dratman <ralph.dratman at gmail.com>wrote:

> Num remains undefined, as far as I can see. Is that intended?
>
> Ralph
>
>
> On Sun, Mar 18, 2012 at 3:40 AM, Nabeel Butt <nabeel.butt at gmail.com>
> wrote:
> > Hi Guys ...
> >     I run a piece of code on two different computers (different
> hardwares)
> > and I get different results.I think its something to do with overflow or
> > different precision on systems ? Personally I think my laptop with an
> > inferior hardware is giving me correct results. The code does involve
> some
> > simulation but running the simulation gives the same result on one
> > particular computer but different for different computers ! You can run
> and
> > tell me what answers you are getting ....Thanks in advance....and my code
> > is below :
> > \[Lambda] = 0.05;
> > \[Mu] = 0.05;
> > T = 1;
> > nn = 4;
> > \[CapitalDelta]T = T/nn;
> > m1 = 0.08;
> > \[Sigma]1 = 0.2;
> > m2 = 0.14;
> > \[Sigma]2 = 0.8;
> > \[Rho] = 0.1;
> > mean1 = (m1 - (\[Sigma]1^2)/2)*\[CapitalDelta]T;
> > var1 = (\[Sigma]1^2)*\[CapitalDelta]T;
> > rmean1 = E^(mean1 + 1/2 var1);
> > rvar1 = ((E^var1 - 1) E^(2*mean1 + var1));
> > mean2 = (m2 - (\[Sigma]2^2)/2)*\[CapitalDelta]T;
> > var2 = (\[Sigma]2^2)*\[CapitalDelta]T;
> > rmean2 = E^(mean2 + 1/2 var2);
> > rvar2 = ((E^var2 - 1) E^(2*mean2 + var2));
> > b1 = {rk1l = 0.001, rk1u = (rmean1 + 5*Sqrt[rvar1])};
> > b2 = {rk2l = 0.001, rk2u = (rmean2 + 5*Sqrt[rvar2])};
> >
> > dl = (rk1u - rk1l)/Num;
> > dk = (rk2u - rk2l)/Num;
> > \[ScriptCapitalD] =
> >  TransformedDistribution[
> >   Exp[ {u, v}], {u, v} \[Distributed]
> >    MultinormalDistribution[{(m1 - (\[Sigma]1^2)/
> >          2)*\[CapitalDelta]T, (m2 - (\[Sigma]2^2)/
> >          2)*\[CapitalDelta]T}, {{\[Sigma]1^2*\[CapitalDelta]T, \
> > \[Rho]*\[Sigma]1*\[Sigma]2*\[CapitalDelta]T}, {\[Rho]*\[Sigma]1*\
> > \[Sigma]2*\[CapitalDelta]T, \[Sigma]2^2*\[CapitalDelta]T}}]];
> > data = Parallelize[RandomVariate[\[ScriptCapitalD], 10^5]];
> > ParallelEvaluate[data];
> >
> >
> > bndry3[Num_, data_] :=
> >  Module[{UU, M, \[Lambda], \[Mu], \[CapitalDelta]T, s, m, \[Sigma],
> >    mean, var, rmean, rvar, rkl, rku, dr, ddist, rvals, pvals, amin,
> >    amax, da, tlist, JN, some, blist, tlist1, tlist2, sol1, sol2,
> >    templist, l, points, pu, pl, dp, a, b, c, zi, Nm, Nz, Na, zW,
> >    m1, \[Sigma]1, m2, \[Sigma]2, \[Rho], mean1, var1, rmean1, rvar1,
> >    mean2, var2, rmean2, rvar2, b1, b2, dl, dk, xvals, yvals, rk1l,
> >    rk1u, rk2l, rk2u, \[ScriptCapitalD]1, dist, \[ScriptCapitalD],
> >    prob, JJ},
> >
> >   Off[InterpolatingFunction::dmval];
> >   sll[ll_, elem_] := ll[[Ordering[ll[[All, elem]]]]];
> >   M = 0.5;
> >   \[Lambda] = 0.05;
> >   \[Mu] = 0.05;
> >   \[CapitalDelta]T = T/nn;
> >   s = E^(0.05*\[CapitalDelta]T);
> >   m1 = 0.08;
> >   \[Sigma]1 = 0.2;
> >   m2 = 0.14;
> >   \[Sigma]2 = 0.8;
> >   \[Rho] = 0.1;
> >   UU = 7;
> >   mean1 = (m1 - (\[Sigma]1^2)/2)*\[CapitalDelta]T;
> >   var1 = (\[Sigma]1^2)*\[CapitalDelta]T;
> >   rmean1 = E^(mean1 + 1/2 var1);
> >   rvar1 = ((E^var1 - 1) E^(2*mean1 + var1));
> >   mean2 = (m2 - (\[Sigma]2^2)/2)*\[CapitalDelta]T;
> >   var2 = (\[Sigma]2^2)*\[CapitalDelta]T;
> >   rmean2 = E^(mean2 + 1/2 var2);
> >   rvar2 = ((E^var2 - 1) E^(2*mean2 + var2));
> >   b1 = {rk1l = 0.001, rk1u = (rmean1 + 5*Sqrt[rvar1])};
> >   b2 = {rk2l = 0.001, rk2u = (rmean2 + 5*Sqrt[rvar2])};
> >
> >   dl = (rk1u - rk1l)/Num;
> >   dk = (rk2u - rk2l)/Num;
> >   \[ScriptCapitalD] =
> >    TransformedDistribution[
> >     Exp[ {u, v}], {u, v} \[Distributed]
> >      MultinormalDistribution[{(m1 - (\[Sigma]1^2)/
> >            2)*\[CapitalDelta]T, (m2 - (\[Sigma]2^2)/
> >            2)*\[CapitalDelta]T}, {{\[Sigma]1^2*\[CapitalDelta]T, \
> > \[Rho]*\[Sigma]1*\[Sigma]2*\[CapitalDelta]T}, {\[Rho]*\[Sigma]1*\
> > \[Sigma]2*\[CapitalDelta]T, \[Sigma]2^2*\[CapitalDelta]T}}]];
> >
> >   \[ScriptCapitalD]1 = SmoothKernelDistribution[data];
> >
> >   g[x_, y_] := Evaluate[CDF[\[ScriptCapitalD]1, {x, y}]];
> >
> >
> >   fx1[r_] := PDF[LogNormalDistribution[mean1, Sqrt[var1]], r];
> >   fx2[r_] := CDF[LogNormalDistribution[mean1, Sqrt[var1]], r];
> >   pu = 1;
> >   pl = 0;
> >   dp = (pu - pl)/Num;
> >   gx1[p_] := InverseCDF[LogNormalDistribution[mean1, Sqrt[var1]], p];
> >   xvals =
> >    Flatten[{rk1l, Table[gx1[i + dp], {i, pl, pu - 2*dp, dp}], rk1u}];
> >
> >   fy1[r_] := PDF[LogNormalDistribution[mean2, Sqrt[var2]], r];
> >   fy2[r_] := CDF[LogNormalDistribution[mean2, Sqrt[var2]], r];
> >   pu = 1;
> >   pl = 0;
> >   dp = (pu - pl)/Num;
> >   gy1[p_] := InverseCDF[LogNormalDistribution[mean2, Sqrt[var2]], p];
> >   yvals =
> >    Flatten[{rk2l, Table[gy1[i + dp], {i, pl, pu - 2*dp, dp}], rk2u}];
> >
> >
> >
> >
> >   f[x_, y_] := Evaluate[PDF[\[ScriptCapitalD]1, {x, y}]];
> >
> >   dist =
> >    Flatten[Table[{prob = (NIntegrate[
> >
> >          f[x, y], {x, xvals[[i]], xvals[[i + 1]]}, {y, yvals[[j]],
> >           yvals[[j + 1]]}, AccuracyGoal -> 4]); {NIntegrate[
> >         x*(f[x, y])/prob
> >         , {x, xvals[[i]], xvals[[i + 1]]}, {y, yvals[[j]],
> >          yvals[[j + 1]]}, AccuracyGoal -> 4],
> >        NIntegrate[
> >         y*(f[x, y])/(prob), {x, xvals[[i]], xvals[[i + 1]]}, {y,
> >          yvals[[j]], yvals[[j + 1]]}, AccuracyGoal -> 4]},
> >
> >       prob}, {i, 1, Num}, {j, 1, Num}], 1];
> >
> >
> >   amin = N[0.001];
> >   amax = N[0.999];
> >   da = 0.01;
> >
> >   (*dist/.{{x_Real,y_Real},z_Real}->x+y+z*)
> >   tlist1 = Parallelize[ParallelEvaluate[
> >      Off[FindMinimum::reged]];
> >     ParallelEvaluate[Off[FindMaximum::lstol]]; Table[{a,
> >       {l =
> >         Max[templist = {(sol1 = Flatten[Last[NestList[{{#[[1, 1]]/2},
> >
> >                    Reverse[
> >                    Last[sll[
> >                    Flatten[
> >                    Table[{{\[Xi]}, (Total[(dist /. {{r_Real, S_Real},
> >                     p_Real} -> (Log[(S + \[Xi] (r -
> >                    S) + \[Mu] (\[Xi] - a) S)]*p))])}, {\[Xi],
> >                    If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
> >                    0, (#[[2, 2, 1]] - 2*#[[1, 1]]), 0],
> >                    If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <=
> >                    a, (#[[2, 2, 1]] + 2*#[[1, 1]]), a], #[[1, 1]]}],
> >                    0], 2]]]} & ,
> >                   {{a/4}, {-100, {a/2}}}, UU]][[2]]])[[1]], (sol2 =
> >               Flatten[Last[NestList[{{#[[1, 1]]/2},
> >
> >                    Reverse[
> >                    Last[sll[
> >                    Flatten[
> >                    Table[{{\[Xi]}, (Total[
> >                    dist /. {{r_Real, S_Real},
> >                    p_Real} -> (Log[(S + \[Xi] (r -
> >                    S) - \[Lambda] (\[Xi] - a) S)]*p)])}, {\[Xi],
> >                    If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
> >                    a, (#[[2, 2, 1]] - 2*#[[1, 1]]), a],
> >                    If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <= (
> >                    1 + a*\[Lambda])/(
> >                    1 + \[Lambda]), (#[[2, 2, 1]] + 2*#[[1, 1]]), (
> >                    1 + a*\[Lambda])/(1 + \[Lambda])], #[[1, 1]]}],
> >                    0], 2]]]} & ,
> >                   {{0.25*((1 + a*\[Lambda])/(1 + \[Lambda]) -
> >                    a)}, {-100, {0.5*(a + (1 + a*\[Lambda])/(
> >                    1 + \[Lambda]))}}}, UU]][[2]]])[[1]],
> >            Total[dist /. {{r_Real, S_Real}, p_Real} ->
> >               Log[(S + a (r - S))]*p]}],
> >        If[templist[[3]] == l, 3,
> >         Flatten[Position[templist, l]][[1]]],
> >        Piecewise[{{0, templist[[3]] == l}, {sol1[[2]],
> >           templist[[1]] == l}, {sol2[[2]],
> >           templist[[2]] == l}}]}}, {a, amin, amax, da}]];
> >   (*points=Select[tlist,#[[2,2]]==3&]/.{a_,{J_,
> >   I_,\[CapitalDelta]_}}->a
> >   Graphics[Point[points],Axes->True]*)
> >   (*points=Select[Flatten[templist/.{{x_,y_},{z_,w_}}->{{x,y},{w}},
> >   1],#[[2]][[1]]==3&]/.{{x_,y_},{w_}}->{x,y};*)
> >   (*points=Select[tlist,#[[2,2]]==3&]/.{x_,{z_,w_}}->x;
> >   points*)
> >   JN = Interpolation[tlist1 /. {x_, {z_, w_, y_}} -> {x, z}];
> >   (*PN=Interpolation[tlist/.{x_,{z_,w_,y_}}->{x,y}];*)
> >   (*Off[InterpolatingFunction::dmval];*)
> >   (*Plot[JN[x],{x,0,1}]*)
> >   some = NestList[(JJ = #[[2]]; {tlist = Parallelize[ParallelEvaluate[
> >           Off[FindMinimum::reged]];
> >          ParallelEvaluate[Off[FindMaximum::lstol]];
> >          ParallelEvaluate[Off[InterpolatingFunction::dmval]];
> >          Table[(*nlist=(#[[1]]/.{x_,{z_,w_,y_}}->y);*){a,
> >            {l =
> >              Max[templist = {(sol1 =
> >                    Flatten[Last[NestList[{{#[[1, 1]]/2},
> >
> >                    Reverse[
> >                    Last[sll[
> >                    Flatten[
> >                    Table[{{\[Xi]}, (Total[
> >                    dist /. {{r_Real, S_Real},
> >                    p_Real} -> (((Log[(S + \[Xi] (r -
> >                    S) + \[Mu] (\[Xi] - a) S)] +
> >                    JJ[(\[Xi]*
> >                    r)/(S + \[Xi] (r - S) + \[Mu] (\[Xi] - a) S)])*
> >                    p))])}, {\[Xi],
> >                    If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
> >                    0, (#[[2, 2, 1]] - 2*#[[1, 1]]), 0],
> >                    If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <=
> >                    a, (#[[2, 2, 1]] + 2*#[[1, 1]]), a], #[[1, 1]]}],
> >                    0], 2]]]} & ,
> >                    {{a/4}, {-100, {a/2}}}, UU]][[2]]])[[1]], (sol2 =
> >                    Flatten[Last[NestList[{{#[[1, 1]]/2},
> >
> >                    Reverse[
> >                    Last[sll[
> >                    Flatten[
> >                    Table[{{\[Xi]}, (Total[
> >                    dist /. {{r_Real, S_Real},
> >                    p_Real} -> ((Log[(S + \[Xi] (r -
> >                    S) - \[Lambda] (\[Xi] - a) S)] +
> >                    JJ[(\[Xi]*
> >                    r)/(S + \[Xi] (r - S) - \[Lambda] (\[Xi] -
> >                    a) S)])*p)])}, {\[Xi],
> >                    If[(#[[2, 2, 1]] - 2*#[[1, 1]]) >=
> >                    a, (#[[2, 2, 1]] - 2*#[[1, 1]]), a],
> >                    If[(#[[2, 2, 1]] + 2*#[[1, 1]]) <= (
> >                    1 + a*\[Lambda])/(
> >                    1 + \[Lambda]), (#[[2, 2, 1]] + 2*#[[1, 1]]), (
> >                    1 + a*\[Lambda])/(1 + \[Lambda])], #[[1, 1]]}],
> >                    0], 2]]]} & ,
> >                    {{0.25*((1 + a*\[Lambda])/(1 + \[Lambda]) -
> >                    a)}, {-100, {0.5*(a + (1 + a*\[Lambda])/(
> >                    1 + \[Lambda]))}}}, UU]][[2]]])[[1]],
> >
> >                 Total[dist /. {{r_Real, S_Real},
> >                    p_Real} -> (Log[(S + a (r - S))] +
> >                    JJ[(a*r)/(a*r + (1 - a) S)])*p]}],
> >             If[templist[[3]] == l, 3,
> >              Flatten[Position[templist, l]][[1]]],
> >             Piecewise[{{0, templist[[3]] == l}, {sol1[[2]],
> >                templist[[1]] == l}, {sol2[[2]],
> >                templist[[2]] == l}}]}}, {a, amin, amax, da}]],
> >        Interpolation[
> >         tlist /. {x_, {z_, w_, y_}} -> {x, z}]}) &, {tlist1, JN},
> >     nn - 1]];
> > stuff = Table[{1/NN, bndry3[NN, data]}, {NN, 4, 7}];
> > listn[a_] := {#[[1]], #[[2]][[4, 2]][a]} & /@ stuff;
> > a = 0.5;
> > g1 = ListPlot[listn[a], PlotStyle -> {Red, PointSize[Large]}]
> >
> ________________________________________________________________________________
> > <
> http://t2.gstatic.com/images?q=tbn:ANd9GcRd4WJa3qO12skxxSAppQ9HimoQsMP5o--uCIe7yxZahJqlkN4z
> >
> > "We have not succeeded in answering all our problems.The answers we have
> > found only serve to raise a whole set of new questions.In some ways we
> feel
> > that we are as confused as ever,but we believe we are confused on a
> higher
> > level and about more important things!! Haha"
> > "One day we  definitely get to see all the beauty present in this world
> > !!!"
> > "Life can only be understood going backwards but it must be lived going
> > forwards!"
> >
> ________________________________________________________________________________
> > THIS MESSAGE IS ONLY INTENDED FOR THE USE OF THE INTENDED
> > RECIPIENT(S) AND MAY CONTAIN INFORMATION THAT IS PRIVILEGED,
> > PROPRIETARY AND/OR CONFIDENTIAL. If you are not the intended
> > recipient, you are hereby notified that any review, retransmission,
> > dissemination, distribution, copying, conversion to hard copy or
> > other use of this communication is strictly prohibited. If you are
> > not the intended recipient and have received this message in error,
> > please notify me by return e-mail and delete this message from your
> > system. Nabeel Butt Inc.
> >
> >
> >
> >
> >
> > Nabeel Butt
> > UWO,London