Re: can anybody help me
- To: mathgroup at smc.vnet.net
- Subject: [mg88081] Re: can anybody help me
- From: dh <dh at metrohm.ch>
- Date: Thu, 24 Apr 2008 05:55:48 -0400 (EDT)
- References: <fun1mg$5j2$1@smc.vnet.net>
Hi,
the superfluous part is commented in the code below:
Manipulate[
points=points//.{left___,{x1_,y1_},middle___,{x1_,y2_},right___}:>{left,middle,{x1,y2},right};
points=points//.{left___,{0.001,y1_},right___}:>{left,right};
points=points//.{left___,{1-0.001,y1_},right___}:>{left,right};
ptsrt=Union[{{10^(-8),0}},points,{{1,0}}];
ptsrt2={{{0},0,ptsrt[[2,2]]/ptsrt[[2,1]]}}~Join~Table[{{ptsrt[[i+1,1]]},ptsrt[[i+1,2]],(ptsrt[[i+2,2]]-ptsrt[[i,2]])/(ptsrt[[i+2,1]]-ptsrt[[i,1]])},{i,Length[ptsrt]-2}]~Join~{{{1},0,-ptsrt[[Length[ptsrt]-1,2]]/(1-ptsrt[[Length[ptsrt]-1,1]])}};Bn=Table[NIntegrate[2
FB[ptsrt,ptsrt2,x,idpolynom]*Sin[m Pi x],{x,0,1}, AccuracyGoal->6],{m,3}];
Plot[{If[id,F[ptsrt,ptsrt2,x,idpolynom]],If[string,F[ptsrt,ptsrt2,x-c*t,idpolynom]/2+F[ptsrt,ptsrt2,x+c*t,idpolynom]/2],If[ltw,F[ptsrt,ptsrt2,x+c*t,idpolynom]/2],If[rtw,F[ptsrt,ptsrt2,x-c*t,idpolynom]/2]},{x,-a,1+a},PlotRange->{{-a,1+a},{-2,2}},ImageSize->{400,300}],
{{idpolynom,1,"initial data"},{1->"piecewise polynomial"(*,2->"piecewise
linear"*)}},
{{c,0.5,"velocity"},0,3,Appearance->"Labeled"},
{{a,0,"x interval"},0,2,1,Appearance->"Labeled"},
{{points,{{1/2,1}}},{0.001,-2},{1-.001,2},Locator,LocatorAutoCreate->{All,{1,10}}},
{{id,True,"initial string"},{False,True}},
{{string,True,"evolving string"},{False,True}},
(*{{ltw,False,"left wave"},{False,True}},
{{rtw,False,"right wave"},{False,True}},*)
{{t,0,"run"},0,Infinity,ControlType->Trigger},
{{modedisp,False,"display modes"},{False,True}},
Dynamic[If[modedisp,GraphicsGrid[{{Plot[Bn[[1]] Sin[Pi x] Cos[t Pi
c],{x,0,1},Frame->True,Axes->False,ImageSize->{160},PlotRange->{{0,1},{-2,2}},PlotLabel->"First
mode"]},
{Plot[Bn[[2]] Sin[2 Pi x] Cos[t c Pi
2],{x,0,1},Frame->True,Axes->False,PlotRange->{{0,1},{-2,2}},PlotLabel->"Second
mode"]},
{Plot[Bn[[3]] Sin[3Pi x] Cos[t c Pi
3],{x,0,1},Frame->True,Axes->False,PlotRange->{{0,1},{-2,2}},PlotLabel->"Third
mode"]
}}]," "]],
ControlPlacement->{Top,Top,Top,Left,Left,Left,Left,Left,Left,Left,Left},
Initialization:>{MyPiecewise[P_,x_]:=Module[{i},Piecewise[Table[{(P[[i+1,2]]-P[[i,2]])/(P[[i+1,1]]-P[[i,1]])
(x-P[[i,1]])+P[[i,2]],P[[i,1]]<x<P[[i+1,1]]},
{i,1,Length[P]-1}]]],
PeriodicExtension[g_,x_]:=If[Abs[x]<1,g[x],PeriodicExtension[g,x-2Sign[x]]],
OddExtension[g_,x_]:=If[x>=0,g[x],-g[-x]],
F[pts_,pts2_,x_,idpolynom_]:=PeriodicExtension[Function[ss,OddExtension[Function[s,
If[idpolynom==2,MyPiecewise[pts,s],Interpolation[pts2][s]]
],ss]],x],
FB[pts_,pts2_,x_,idpolynom_]:=
If[idpolynom==2,MyPiecewise[pts,x],Interpolation[pts2][x]]
},TrackedSymbols:>Manipulate,AutorunSequencing->{1,3,4,7,9},ControllerLinking->False
]
Daniel
mrtince wrote:
> http://rapidshare.com/files/109739889/sdads.nb.html
>
> in these nb file.i want to remove "left wave" , "right wave" , and
> "piecewise linear" but i can't succeed it.
>