|
Die Authoren des Buches Partial Differential Equations and Mathematica verwenden in ihrem Beispiel (http://www.crcpress.com/books/isbn/0-8493-7853-2/chap10/fd.ma) eine entsprechende Routine von: A Finite Difference Generator credit The Mathematica code that follows was adapted from the "Symbolic Finite Difference Code Generation and Analysis" notebook, written by T.G. Shawki Department of Theoretical and Applied Mechanics University of Illinois at Urbana-Champaign Urbana, IL 61801. Implementation The Mathematica code presented here generates finite difference approximations. The module FDG; approximates derivatives of the function U[x,y]. FDG takes 4 arguments: var: x or y variable. NPts: number of points used to approximate a derivative. Side: takes values: -1, 0, +1 where -1 corresponds to left-handed, 0 corresponds to centered, 1 corresponds to right-handed derivative is 1 for first derivatives, 2 for second derivatives, etc. In[1]:= FDG::usage="FDG[var,NPts,Side,derivative] generates a finite difference approximation.\n\n var is the variable x or y.\n Npts is the number of points used to approximate a derivative.\n Side takes value \n -1 for left,\n 0 for centered\n 1 for right."; In[2]:= ?FDG In[3]:= FDG[var_, NPts_, Side_, derivative_] := Block[{imin, v, incre, imax, x, y, arg, argnum, arg1, arg2, increments, h, k}, v = var; arg = {x, y}; argnum = Flatten[Position[arg, v]][[1]]; arg1 = {x + ii*h, y}; arg2 = {x, y + ii*k}; arg = {arg1, arg2}; increments = {h, k}; incre = increments[[argnum]]; myfnc[ii_, order_] := Normal[Series[U @@ arg[[argnum]], {incre, 0, order}]]; trans[a_, b_] := u[i + a, j + b]; AccTrans = Flatten[Table[Table[trans[a, b] -> U[x + a*h, y + b*k], {a, -NPts, NPts}], {b, -NPts, NPts}]]; int = NPts - 1; If[Side == 0, {imin = -(int/2), imax = imin + int}]; If[Side == 1, {imin = 0, imax = imin + int}]; If[Side == -1, {imax = 0, imin = imax - int}]; expansion = Sum[c[ii]*myfnc[ii, int], {ii, imin, imax}]; exp2 = Collect[expansion, Table[incre^ii, {ii, int}]]; Eqn[ii_] := Coefficient[exp2, incre, ii]; eqns = Table[Eqn[ii] == 0, {ii, 0, int}]; eqns = ReplacePart[eqns, Eqn[derivative] == D[U[x, y], {v, derivative}]/incre^derivative, derivative + 1]; coeffs = Table[c[ii], {ii, imin, imax}]; sol = Solve[eqns, coeffs]; iarg = {{i + s, j}, {i, j + s}}; diff = Sum[c[s]*u @@ iarg[[argnum]], {s, imin, imax}] /. sol; diff = First[diff]] Examples Centered difference for first x derivative FDG[x,3,0,1]//Together Centered difference for first y derivative FDG[y,3,0,1]//Together Centered difference for second x derivative FDG[x,3,0,2]//Together Centered difference for second y derivative FDG[y,3,0,2]//Together One sided difference for first x derivative FDG[x,2,1,1]//Together One sided difference (right) for first x derivative FDG[x,3,1,2]//Together LaPlace Equation: D[u,x,2] + D[u,y,x] = 0 LaplaceEqn = FDG[x,3,0,2] + FDG[y,3,0,2] == 0 Assuming k = h we obtain: Solve[LaplaceEqn/.k->h //Simplify, u[i,j] ]//Flatten ---------- >Von: Gunter Woysch <Gunter_Woysch@XXXXXXX.com> >An: DMUG <dmug@XXXXXXX.ch> >Betreff: MMa 3 : Uebersetzer (P)DE -> ( partielle ) Differenzen-Gleichungen ? >Datum: Don, 10. Dez 1998 7:41 Uhr > >Stuttgart, den 10. Dezember 1998 > >An alle Mathematica-Kundigen ! > >Wenn man die Grenzwertbildung, die zur Definition von >Differential-Quotienten fuehrt, >rueckgaengig macht, dann erhaelt man wieder Differenzen-Gleichungen. > >Meine Frage : > > Gibt es vielleicht in Mathematica Funktionen, > > die einen Uebersetzer > > _von_ ( partiellen ) Differential-Gleichungen - > bzw. den entsprechenden >Mathematica-Differential-Quotienten-Funktionen - > > _in_ ( partielle ) Differenzen-Gleichungen > > realisieren ? > >Es gibt sicher Anwendungen, in denen man einen solchen Uebersetzer gut >gebrauchen koennte ! > >Vielen Dank fuer eine kurze Antwort ! > >Mit freundlichen Gruessen > >Gunter Woysch > >----- > Dr. Gunter Woysch > Reisstr. 15 > D 70435 Stuttgart > eMail Gunter_Woysch@XXXXXXX.com >----- > |