minimization
- To: mathgroup at smc.vnet.net
- Subject: [mg124667] minimization
- From: Herman <btta2010 at gmail.com>
- Date: Mon, 30 Jan 2012 05:10:09 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
Hello,
I want to plot the function dis[....] as a function of time, t. My problem is that I want to minimize the expression I0[....] over all values of \rho & \phi and to substitute this into the expression dis[...] to plot as a function of t. The parameters \alpha=0.1, \omega=2, r=1 depends on my choice.
Many thanks for any comments with the syntax.
Clear[\[Rho], \[Phi]]
\[CapitalDelta][\[Alpha]_, \[Omega]0_, t_] = -\[Alpha]^2 1/
Sqrt[\[Omega]0] \[Pi] (-1 +
FresnelC[Sqrt[2/\[Pi]] Sqrt[t \[Omega]0]]) FresnelC[
Sqrt[2/\[Pi]] Sqrt[t \[Omega]0]];
\
\
\[CapitalPi][\[Alpha]_, \[Omega]0_, t_] = \[Alpha]^2
Integrate[(
Sqrt[\[Pi]/
2] (1 - 2 FresnelC[Sqrt[2/\[Pi]] Sqrt[b \[Omega]0]]) Sin[
b \[Omega]0])/Sqrt[b], {b, 0, t}];
\[Gamma][\[Alpha]_, \[Omega]0_,
t_] = -\[Alpha]^2 (\[Pi] (-1 +
FresnelS[Sqrt[2/\[Pi]] Sqrt[t \[Omega]0]]) FresnelS[
Sqrt[2/\[Pi]] Sqrt[t \[Omega]0]])/Sqrt[\[Omega]0];
ClearAll[\[CapitalGamma]]
\[CapitalGamma][\[Alpha]_?NumericQ, \[Omega]0_?NumericQ,
t_?NumericQ] :=
NIntegrate[2*\[Gamma][\[Alpha], \[Omega]0, s], {s, 0, t}]
ClearAll[\[CapitalDelta]\[CapitalGamma]]
\[CapitalGamma][\[Alpha]_?NumericQ, \[Omega]0_?NumericQ, t_?NumericQ]
:= NIntegrate[2*\[Gamma][\[Alpha], \[Omega]0, s], {s, 0, t}]
\[CapitalDelta]\[CapitalGamma][\[Alpha]_?NumericQ, \[Omega]0_?
NumericQ, t_?NumericQ] :=
NIntegrate[\[CapitalDelta][\[Alpha], \[Omega]0, s], {s, 0, t}]
\[CapitalDelta]co[\[Alpha]_?NumericQ, \[Omega]0_?NumericQ,
t_?NumericQ] :=
NIntegrate[\[CapitalDelta][\[Alpha], \[Omega]0, s]*
Cos[2 \[Omega]0 (t - s)], {s, 0, t}]
\[CapitalDelta]co[0.1, 1, 4]
0.00375065
\[CapitalDelta]si[\[Alpha]_?NumericQ, \[Omega]0_?NumericQ,
t_?NumericQ] :=
NIntegrate[\[CapitalDelta][\[Alpha], \[Omega]0, s]*
Sin[2 \[Omega]0 (t - s)], {s, 0, t}]
\[CapitalPi]co[\[Alpha]_?NumericQ, \[Omega]0_?NumericQ, t_?NumericQ] :=
NIntegrate[\[CapitalPi][\[Alpha], \[Omega]0, s]*
Cos[2 \[Omega]0 (t - s)], {s, 0, t}]
\[CapitalPi]si[\[Alpha]_?NumericQ, \[Omega]0_?NumericQ, t_?NumericQ] :=
NIntegrate[\[CapitalPi][\[Alpha], \[Omega]0, s]*
Sin[2 \[Omega]0 (t - s)], {s, 0, t}]
Clear[A0]
A0[r_] := {{1/2 Cosh[2 r], 0}, {0, 1/2 Cosh[2 r]}}
At[\[Alpha]_, \[Omega]0_, t_, r_] :=
A0[r]*(1 - \[CapitalGamma][\[Alpha], \[Omega]0,
t]) + {{\[CapitalDelta]\[CapitalGamma][\[Alpha], \[Omega]0,
t] + (\[CapitalDelta]co[\[Alpha], \[Omega]0,
t] - \[CapitalPi]si[\[Alpha], \[Omega]0,
t]), -(\[CapitalDelta]si[\[Alpha], \[Omega]0,
t] - \[CapitalPi]co[\[Alpha], \[Omega]0,
t])}, {-(\[CapitalDelta]si[\[Alpha], \[Omega]0,
t] - \[CapitalPi]co[\[Alpha], \[Omega]0,
t]), \[CapitalDelta]\[CapitalGamma][\[Alpha], \[Omega]0,
t] - (\[CapitalDelta]co[\[Alpha], \[Omega]0,
t] - \[CapitalPi]si[\[Alpha], \[Omega]0, t])}}
Ats[\[Alpha]_, \[Omega]0_, t_, r_] :=
A0[r]*(1 - \[CapitalGamma][\[Alpha], \[Omega]0,
t]) + {{\[CapitalDelta]\[CapitalGamma][\[Alpha], \[Omega]0, t],
0}, {0, \[CapitalDelta]\[CapitalGamma][\[Alpha], \[Omega]0, t]}}
Ct[\[Alpha]_, \[Omega]0_, t_, r_] :=
1/2 Sinh[2 r]*(1 - \[CapitalGamma][\[Alpha], \[Omega]0, t]) {{Cos [
2 \[Omega]0 t],
Sin [2 \[Omega]0 t]}, {Sin [2 \[Omega]0 t], -
Cos [2 \[Omega]0 t]}}
\[Sigma]t[\[Alpha]_, \[Omega]0_, t_,
r_] := {{At[\[Alpha], \[Omega]0, t, r],
Ct[\[Alpha], \[Omega]0, t,
r]}, {Ct[\[Alpha], \[Omega]0, t, r]\[Transpose],
At[\[Alpha], \[Omega]0, t, r]}}
\[Sigma]ts[\[Alpha]_, \[Omega]0_, t_,
r_] := {{Ats[\[Alpha], \[Omega]0, t, r],
Ct[\[Alpha], \[Omega]0, t,
r]}, {Ct[\[Alpha], \[Omega]0, t, r]\[Transpose],
Ats[\[Alpha], \[Omega]0, t, r]}}
I1[\[Alpha]_, \[Omega]0_, t_, r_] :=
Det[At[\[Alpha], \[Omega]0, t, r]]
I1s[\[Alpha]_, \[Omega]0_, t_, r_] :=
Det[Ats[\[Alpha], \[Omega]0, t, r]]
I3[\[Alpha]_, \[Omega]0_, t_, r_] :=
Det[Ct[\[Alpha], \[Omega]0, t, r]]
I4[\[Alpha]_, \[Omega]0_, t_, r_] :=
Det[\[Sigma]t[\[Alpha], \[Omega]0, t, r]]
I4s[\[Alpha]_, \[Omega]0_, t_, r_] :=
Det[\[Sigma]ts[\[Alpha], \[Omega]0, t, r]]
C1[\[Alpha]_, \[Omega]0_, t_,
r_] := \[Sqrt](1/(
2 I1[\[Alpha], \[Omega]0, t,
r]) (I1[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4[\[Alpha], \[Omega]0, t,
r] + \[Sqrt]((I1[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4[\[Alpha], \[Omega]0, t,
r])^2 - (2 I1[\[Alpha], \[Omega]0, t, r]*
I3[\[Alpha], \[Omega]0, t, r])^2 )))
C1s[\[Alpha]_, \[Omega]0_, t_,
r_] := \[Sqrt](1/(
2 I1s[\[Alpha], \[Omega]0, t,
r]) (I1s[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4s[\[Alpha], \[Omega]0, t,
r] + \[Sqrt]((I1s[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4s[\[Alpha], \[Omega]0, t,
r])^2 - (2 I1s[\[Alpha], \[Omega]0, t, r]*
I3[\[Alpha], \[Omega]0, t, r])^2 )))
C2[\[Alpha]_, \[Omega]0_, t_,
r_] := \[Sqrt](1/(
2 I1[\[Alpha], \[Omega]0, t,
r]) (I1[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4[\[Alpha], \[Omega]0, t,
r] - \[Sqrt]((I1[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4[\[Alpha], \[Omega]0, t,
r])^2 - (2 I1[\[Alpha], \[Omega]0, t, r]*
I3[\[Alpha], \[Omega]0, t, r])^2 )))
C2s[\[Alpha]_, \[Omega]0_, t_,
r_] := \[Sqrt](1/(
2 I1s[\[Alpha], \[Omega]0, t,
r]) (I1s[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4s[\[Alpha], \[Omega]0, t,
r] - \[Sqrt]((I1s[\[Alpha], \[Omega]0, t, r]^2 +
I3[\[Alpha], \[Omega]0, t, r]^2 -
I4s[\[Alpha], \[Omega]0, t,
r])^2 - (2 I1s[\[Alpha], \[Omega]0, t, r]*
I3[\[Alpha], \[Omega]0, t, r])^2 )))
an[\[Alpha]_, \[Omega]0_, t_, r_] := Sqrt[
I1[\[Alpha], \[Omega]0, t, r]]
ans[\[Alpha]_, \[Omega]0_, t_, r_] := Sqrt[
I1s[\[Alpha], \[Omega]0, t, r]]
\[Kappa]1[\[Alpha]_, \[Omega]0_, t_,
r_] := Sqrt[(an[\[Alpha], \[Omega]0, t, r] -
C1[\[Alpha], \[Omega]0, t, r])*(an[\[Alpha], \[Omega]0, t, r] -
C2[\[Alpha], \[Omega]0, t, r])]
\[Kappa]1s[\[Alpha]_, \[Omega]0_, t_,
r_] := Sqrt[(ans[\[Alpha], \[Omega]0, t, r] -
C1s[\[Alpha], \[Omega]0, t, r])*(ans[\[Alpha], \[Omega]0, t, r] -
C2s[\[Alpha], \[Omega]0, t, r])]
xm[\[Alpha]_, \[Omega]0_, t_,
r_] := (\[Kappa]1[\[Alpha], \[Omega]0, t, r]^2 + 1/4)/(
2 \[Kappa]1[\[Alpha], \[Omega]0, t, r])
xms[\[Alpha]_, \[Omega]0_, t_,
r_] := (\[Kappa]1s[\[Alpha], \[Omega]0, t, r]^2 + 1/4)/(
2 \[Kappa]1s[\[Alpha], \[Omega]0, t, r])
g[x_] := (x + 1/2) Log[x + 1/2] - (x - 1/2) Log[x - 1/2]
eof[\[Alpha]_, \[Omega]0_, t_, r_] :=
g[xm[\[Alpha], \[Omega]0, t, r]]
eofs[\[Alpha]_, \[Omega]0_, t_, r_] :=
g[xms[\[Alpha], \[Omega]0, t, r]]
g1[\[Alpha]_, \[Omega]0_, t_, r_] := g[an[\[Alpha], \[Omega]0, t, r]]
\[Sigma]M[\[Rho]_, \[Phi]_] :=
Cosh[2 \[Rho]]/
2 ({{1 + Tanh[2 \[Rho]] Cos[\[Phi]], -Tanh [
2 \[Rho]] Sin[\[Phi]] }, {-Tanh [2 \[Rho]] Sin[\[Phi]],
1 - Tanh[2 \[Rho]] Cos[\[Phi]]}})
s[\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] :=
Inverse[At[\[Alpha], \[Omega]0, t, r] + \[Sigma]M[\[Rho], \[Phi]]]
\[Tau][\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] :=
At[\[Alpha], \[Omega]0, t, r] -
Ct[\[Alpha], \[Omega]0, t, r].s[\[Alpha], \[Omega]0, t,
r, \[Rho], \[Phi]].Ct[\[Alpha], \[Omega]0, t, r]\[Transpose]
I0[\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] :=
Re[Det[\[Tau][\[Alpha], \[Omega]0, t, r, \[Rho], \[Phi]]]]
{\[Rho], \[Phi]} = {\[Rho], \[Phi]} /.
Table[FindMinimum[{I0[0.1, 2, t, 2, \[Rho], \[Phi]], \[Rho] >= 0,
0 <= \[Phi] <= 2 \[Pi]}, {\[Rho], \[Phi]}], {t, 0, 2}];
ReplaceAll::rmix: Elements of {0.25,{1->0.000876434}} are a mixture \
of lists and nonlists. >>
ReplaceAll::rmix: Elements of {7.8194,{1->0.000200853}} are a mixture \
of lists and nonlists. >>
ReplaceAll::rmix: Elements of {13.333,{1->0.000272136}} are a mixture \
of lists and nonlists. >>
General::stop: Further output of ReplaceAll::rmix will be suppressed \
during this calculation. >>
Set::shape: Lists {\[Rho],\[Phi]} and \
{{1,0.628319}/.{0.25,{1->0.000876434}},{1,0.628319}/.{7.8194,{1->0.\
000200853}},{1,0.628319}/.{13.333,{1->0.000272136}}} are not the same \
shape. >>
k[\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] := Sqrt[
I0[\[Alpha], \[Omega]0, t, r, \[Rho], \[Phi]]]
k1[\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] :=
Re[k[\[Alpha], \[Omega]0, t, r, \[Rho], \[Phi]]]
h[\[Alpha]_, \[Omega]0_, t_, r_] :=
Re[2 (I1[\[Alpha], \[Omega]0, t, r] +
I3[\[Alpha], \[Omega]0, t, r])]
h1[\[Alpha]_, \[Omega]0_, t_, r_] :=
Re[Sqrt[(h[\[Alpha], \[Omega]0, t, r] + Sqrt[
h[\[Alpha], \[Omega]0, t, r]^2 - 4 I4[\[Alpha], \[Omega]0, t, r]])/
2]]
h2[\[Alpha]_, \[Omega]0_, t_, r_] := Sqrt[(
h[\[Alpha], \[Omega]0, t, r] - Sqrt[
h[\[Alpha], \[Omega]0, t, r]^2 -
4 I4[\[Alpha], \[Omega]0, t, r]])/2]
s1[\[Alpha]_, \[Omega]0_, t_, r_] :=
Re[g[h1[\[Alpha], \[Omega]0, t, r]]]
s2[\[Alpha]_, \[Omega]0_, t_, r_] :=
Re[g[h2[\[Alpha], \[Omega]0, t, r]]]
dis[\[Alpha]_, \[Omega]0_, t_, r_, \[Rho]_, \[Phi]_] :=
Re[g1[\[Alpha], \[Omega]0, t, r] +
k1[\[Alpha], \[Omega]0, t, r, \[Rho], \[Phi]] -
s2[\[Alpha], \[Omega]0, t, r] - s1[\[Alpha], \[Omega]0, t, r]]
\[Alpha] = 0.1;
\[Omega]0 = 2;
\[Rho] = 1;
\[Phi] = 0.6283185307179586;
mylisth =
Table[{t, dis[\[Alpha], \[Omega]0, t, 2, \[Rho], \[Phi]]}, {t, 0, 10,
2}]
$Aborted
QD = ListPlot[mylisth, Joined -> True, PlotStyle -> {Blue, Thick},
AxesOrigin -> {0, 0}]
mylist = Table[{t, eof[\[Alpha], \[Omega]0, t, 2]}, {t, 0, 10, 2}]
enof = ListPlot[mylist, Joined -> True,
PlotStyle -> {Dashed, Red, Thick}, AxesOrigin -> {0, 0}]
Show[QD, enof, AxesStyle -> Thickness[0.002], PlotRange -> All,
AxesOrigin -> {0, 0}]