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}]



• Prev by Date: Re: navigate notebook, further question
• Next by Date: Locator-set Bezier curves mapped to 3D surface
• Previous by thread: Re: navigate notebook, further question
• Next by thread: Locator-set Bezier curves mapped to 3D surface