(*by Nasser M. Abbasi, version: July 31 2013 *) Manipulate[ Module[{xx, yy, opt = {PerformanceGoal -> "Quality", ImageMargins -> 1}, r, r0, c0, a00, b00, color0}, c0 = Sqrt[tension*1000/(\[Rho]0*10^6)]; a00 = a0/1000; (*mm to meter*) b00 = b0/1000; r = w[x, y, a00, b00, m0, n0, c0, t, t0]; (*saved for tooltip to show analytical form*) r0 = r /. {t -> t0, x -> xx, y -> yy}; (*used for plotting*) Which[ color == 1, color0 = Automatic, color == 2, color0 = (ColorData["TemperatureMap"][#3] &), color == 3, color0 = Function[{x, y, z}, Hue[z]], color == 4, color0 = "BlueGreenYellow", color == 5, color0 = "Rainbow", color == 6, color0 = Function[{x, y}, ColorData["NeonColors"][y]] ]; Grid[{ { Which[plotType == "3D", Plot3D[ Tooltip[Evaluate@r0, Text[Style[TraditionalForm[r], 12]]], {xx, 0, a00}, {yy, 0, b00}, Evaluate@opt, ImageSize -> {350, 436}, PlotRange -> {{0, a00}, {0, b00}, {-yMax, yMax}}, Mesh -> meshLines, AxesLabel -> {x, y, u}, PreserveImageOptions -> True, (*RotationAction\[Rule]"Clip",*) SphericalRegion -> True, PlotStyle -> Directive[Opacity[opacity]], ColorFunction -> color0, ImagePadding -> {{25, 5}, {10, 10}}], plotType == "contour", ContourPlot[Evaluate@r0, {xx, 0, a00}, {yy, 0, b00}, Evaluate@opt, ImageSize -> {350, 436}, FrameLabel -> {{y, None}, {x, None}}, ColorFunction -> "Pastel", ImagePadding -> 30, FrameTicksStyle -> 8, Contours -> contoursLines], plotType == "both", Grid[{ {Plot3D[ Tooltip[Evaluate@r0, Text[Style[TraditionalForm[r], 12]]], {xx, 0, a00}, {yy, 0, b00}, Evaluate@opt, ImageSize -> {350, 210}, PlotRange -> {{0, a00}, {0, b00}, {-yMax, yMax}}, Mesh -> meshLines, ImagePadding -> {{25, 5}, {10, 10}}, PreserveImageOptions -> True, SphericalRegion -> True, PlotStyle -> Directive[Opacity[opacity]], AxesLabel -> {x, y, u}] }, { ContourPlot[Evaluate@r0, {xx, 0, a00}, {yy, 0, b00}, Evaluate@opt, ImageSize -> {350, 210}, FrameLabel -> {{y, None}, {x, None}}, ColorFunction -> "Pastel", ImagePadding -> 30, FrameTicksStyle -> 8, Contours -> contoursLines] } }, Spacings -> {0, 0}, Alignment -> Center ] ] , SpanFromLeft} }, Alignment -> Center, Spacings -> 0 ] ], Text@Grid[{ { Style[ TraditionalForm[ Defer[D[u[x, y, t], {x, 2}] + D[u[x, y, t], {y, 2}]] == Defer[HoldForm[1/c^2] D[u[x, y, t], {t, 2}]]], 14], SpanFromLeft }, { Grid[{ {Grid[{ { Row[{Style[ TraditionalForm[ Defer[HoldForm[ Subscript[\[Omega], m n] = c \[Pi] Sqrt[m^2/a^2 + n^2/b^2]]]], 14], Spacer[3], "(hz)"}] }, { Dynamic[getW[Sqrt[tension/\[Rho]0], a0/1000, b0/1000]] } }, Spacings -> .1 ] }, { Dynamic[Grid[ { {Row[{Style["c", Italic, 12], Spacer[2], "(m/s)"}], Row[{\[Lambda], " = ", Style[a/b, Italic]}]}, {padIt2[Sqrt[tension/\[Rho]0], {4, 2}], padIt2[N[a0/b0], {4, 2}]} }, Frame -> All, FrameStyle -> Directive[Thickness[.001], Gray], Spacings -> {.8, .4} ]] } }, Alignment -> Center, Spacings -> {.1, .1} ] }, {Grid[{ { Grid[{ { Style["T", Italic, 12], Manipulator[ Dynamic[tension, {tension = #} &], {0.1, 10, 0.1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[tension, {3, 1}]], "N/mm" }, { Style[\[Rho], Italic, 12], Manipulator[ Dynamic[\[Rho]0, {\[Rho]0 = #} &], {0.1, 2, 0.1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[\[Rho]0, {2, 1}]], "kg/\!\(\*SuperscriptBox[\(mm\), \(2\)]\)" }, { Style["a", Italic, 12], Manipulator[Dynamic[a0, {a0 = #} &], {10, 1000, 1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[a0, 4]], "mm" }, { Style["b", Italic, 12], Manipulator[Dynamic[b0, {b0 = #} &], {10, 1000, 1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[b0, 4]], "mm" } }, Spacings -> {.4, 0}, Alignment -> Left ] } }, Spacings -> {.5, .6}, Alignment -> Center ], SpanFromLeft }, { Grid[{ { Grid[{ {Item[Style["modes to excite", 12], Alignment -> Center], SpanFromLeft}, { Grid[{ {Style["m", Italic, 12], TogglerBar[Dynamic[m0, {m0 = #} &], Range[5]] }, {Style["n", Italic, 12], TogglerBar[Dynamic[n0, {n0 = #} &], Range[5]] } }, Spacings -> {.3, .2}, Alignment -> Left ] } }, Spacings -> {.5, .6}, Alignment -> Center ], Grid[{ { Style["plot type", 10], PopupMenu[Dynamic[plotType, {plotType = #} &], { "3D" -> Style["3D plot", 10], "contour" -> Style["contour plot", 10], "both" -> Style["3D+contour", 10] }, ImageSize -> All ] } , { Style["3D color", 10], PopupMenu[Dynamic[color, {color = #} &], { 1, 2, 3, 4, 5, 6 }, ImageSize -> All ] } }, Spacings -> {0.2, 0.1}, Alignment -> Left ] } }, Spacings -> {.3, .6}, Alignment -> Center, Frame -> True, FrameStyle -> Directive[Thickness[.001], Gray] ] } , { Grid[{ { Grid[{ { Text@"animate", Trigger[Dynamic[t0, {t0 = #} &], {0, 10000}, AnimationRepetitions -> Infinity, AnimationRate -> 10, ImageSize -> Tiny, AppearanceElements -> {"TriggerButton", "PauseButton", "ResetButton"}, DisplayAllSteps -> True], Dynamic[padIt2[t0, {7, 2}]], " sec" }, {Text@"plot range", Manipulator[Dynamic[yMax, {yMax = #} &], {0.1, 15, 0.1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[yMax, {3, 1}]], " m" }, {Text@"mesh lines", Manipulator[ Dynamic[meshLines, {meshLines = #} &], {0, 20, 1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[meshLines, 2]] }, {Text@"opacity", Manipulator[ Dynamic[opacity, {opacity = #} &], {0.01, 1, 0.01}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[opacity, {2, 2}]] }, { Text@"contour lines", Manipulator[ Dynamic[contoursLines, {contoursLines = #} &], {1, 16, 1}, ImageSize -> Small, ContinuousAction -> True], Dynamic[padIt2[contoursLines, 2]], "" } }, Spacings -> {.3, .1}, Alignment -> Left ] } }, Spacings -> {.5, .6}, Alignment -> Center, Frame -> False], SpanFromLeft } }, Alignment -> Center, Spacings -> {0.5, .4}, Frame -> True, FrameStyle -> Directive[Thickness[.001], Gray] ], {{color, 1}, None}, {{tension, 0.1}, None}, {{\[Rho]0, 1}, None}, {{opacity, .8}, None}, {{yMax, 1.6}, None}, {{t0, 0}, None}, {{a0, 100}, None}, {{b0, 100}, None}, {{m0, {1}}, None}, {{n0, {1}}, None}, {{meshLines, 10}, None}, {{plotType, "3D"}, None}, {{contoursLines, 10}, None}, SynchronousUpdating -> False, Alignment -> Center, ImageMargins -> 2,(*important*) FrameMargins -> 1, SynchronousInitialization -> True, ContinuousAction -> False, Alignment -> Center, Paneled -> True, Frame -> False, AutorunSequencing -> Automatic, ControlPlacement -> Left, Initialization :> { integerStrictPositive = (IntegerQ[#] && # > 0 &); integerPositive = (IntegerQ[#] && # >= 0 &); numericStrictPositive = (Element[#, Reals] && # > 0 &); numericPositive = (Element[#, Reals] && # >= 0 &); numericStrictNegative = (Element[#, Reals] && # < 0 &); numericNegative = (Element[#, Reals] && # <= 0 &); bool = (Element[#, Booleans] &); numeric = (Element[#, Reals] &); integer = (Element[#, Integers] &); (*--------------------------------------------*) (* helper function for formatting *) (*--------------------------------------------*) padIt1[v_?numeric, f_List] := AccountingForm[Chop[v] , f, NumberSigns -> {"-", "+"}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) (* helper function for formatting *) (*--------------------------------------------*) padIt2[v_?numeric, f_List] := AccountingForm[Chop[v] , f, NumberSigns -> {"", ""}, NumberPadding -> {"0", "0"}, SignPadding -> True]; padIt2[v_?numeric, f_Integer] := AccountingForm[Chop[v] , f, NumberSigns -> {"", ""}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) w[x_, y_, a_, b_, mm_, nn_, c_, t_, t0_] := Module[{m, n, f}, Sum[Sum[ If[MemberQ[mm, m] && MemberQ[nn, n], f = N@freq[c, a, b, m, n]; Sin[(m Pi x)/a] Sin[(n Pi y)/b] If[t0 == 0, 1, (Cos[f t] + Sin[f t])], 0], {m, 1, 5}], {n, 1, 5}] ]; (*--------------------------------------------*) freq[c_, a_, b_, m_, n_] := Pi c Sqrt[(m/a)^2 + (n/b)^2]; (*--------------------------------------------*) getW[c_, a_, b_] := Module[{m, n, g, wmn}, g = Table[0, {6}, {6}]; wmn = Table[padIt2[N@freq[c, a, b, m, n]/(2*Pi), {6, 2}], {m, 1, 5}, {n, 1, 5}]; g[[1, All]] = {"", 1, 2, 3, 4, 5}; g[[All, 1]] = {"", 1, 2, 3, 4, 5}; g[[2 ;;, 2 ;;]] = wmn; g[[1, 1]] = Style["n\\m", Italic]; Grid[g, Frame -> All, FrameStyle -> Directive[Thickness[.001], Gray], Spacings -> {.8, .8}] ]; } ]