Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

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.

> 




  • Prev by Date: Re: Re: A Problem with Simplify
  • Next by Date: Re: Print[Plot] vs Print[text,Plot]? (*now Do and Table*)
  • Previous by thread: can anybody help me
  • Next by thread: Generating HTML like online Documentation Center