(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 85568, 2506]*) (*NotebookOutlinePosition[ 118974, 3644]*) (* CellTagsIndexPosition[ 117770, 3613]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Variational Schemes for Bounded Domains", "Chapter", CounterAssignments->{{"Chapter", 5}}, CellTags->"CHA variational"], Cell[TextData[{ "To evaluate a particular cell, simply hit \"Shift+Enter\" with the cursor \ positioned in that cell. If ", StyleBox["Mathematica", FontSlant->"Italic"], " asks to evaluate initialization cell, click \"Yes\". See the ", StyleBox["Mathematica ", FontSlant->"Italic"], "Help browser or wolfram.com for more information on using ", StyleBox["Mathematica", FontSlant->"Italic"], "." }], "Text"], Cell["\<\ This notebook and those for the other seven chapters use a common stylesheet \ that has been imported into the notebook. This style sheet supports \ chapters, section, subsections, numbered equations, numbered figures and \ citations. A separate copy of the stylesheet can be download from the same \ page where this notebook was downloaded. \ \>", "Text"], Cell[TextData[{ StyleBox["COPYRIGHT ISSUES:", FontWeight->"Bold"], " The authors reserve all copyrights associated with this work. Any of \ the material appearing in these notebooks (such as the polyhedral meshes in \ chapter 7) can be used and modified without restriction as long as the use is \ non\[Hyphen]commercial. We simply ask that you acknowledge the authors when \ using material from these notebooks. For those readers interested in \ commercial use of the material in these notebooks, please contact \ jwarren@cs.rice.edu." }], "Text"], Cell[CellGroupData[{ Cell["Helper functions from previous chapters", "Subsubsection"], Cell[BoxData[ \(plotCoeff[p_, opts___] := Show[Graphics[{Line[p], PointSize[0.02], RGBColor[1, 0, 0], Map[Point, p]}], Join[{opts}, {Axes \[Rule] True, Ticks \[Rule] {Automatic, Automatic}}]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(makeCoeff[genFun_, {{minX_, maxX_}, {minY_, maxY_}}, k_, x_, y_] := With[{expFun = Expand[genFun]}, \n\t Table[With[{rowY = Table[Coefficient[expFun, y, j], {j, \(2\^k\) minY, \(2\^k\) maxY}]}, \n\t\t\t\tTable[ Coefficient[rowY, x, i], {i, \(2\^k\) minX, \(2\^k\) maxX}]]]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(plotCoeff3D[p_, plotArgs___] := Show[Graphics3D[\[IndentingNewLine]Table[ Polygon[{p\[LeftDoubleBracket]i, j\[RightDoubleBracket], p\[LeftDoubleBracket]i + 1, j\[RightDoubleBracket], p\[LeftDoubleBracket]i + 1, j + 1\[RightDoubleBracket], p\[LeftDoubleBracket]i, j + 1\[RightDoubleBracket]}], {i, \(Dimensions[ p]\)\[LeftDoubleBracket]1\[RightDoubleBracket] - 1}, {j, \(Dimensions[ p]\)\[LeftDoubleBracket]2\[RightDoubleBracket] - 1}]], Join[{plotArgs}, {Axes \[Rule] True}]]\)], "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["Inner products for stationary subdivision schemes", "Section"], Cell[CellGroupData[{ Cell["Exact derivatives", "Subsection"], Cell[CellGroupData[{ Cell["Compute exact interpolation mask for uniform schemes", "Subsubsection"], Cell[TextData[{ "Turn off warning messages from ", Cell[BoxData[ \(Solve\)]] }], "Text"], Cell[BoxData[ \(\(Off[Solve::svars];\)\)], "Input", InitializationCell->True], Cell[TextData[{ "Computation of left eigenvector of the form ", Cell[BoxData[ \(n\ S \[Equal] n\)]], " for uniform subdivision matrix ", Cell[BoxData[ \(S\)]], " with mask ", Cell[BoxData[ \(s[x]\)]], ". The entries of this vector defined the exact interpolation mask for a \ uniform subdivision scheme. Convert into equivalent generating function \ expression of the form ", Cell[BoxData[ \(n[x] s[x] \[Equal] n[x\^2] + x*r[x\^2]\)]], " where ", Cell[BoxData[ \(r[x]\)]], " is an arbitrary residual term. Normalize via ", Cell[BoxData[ \(n[1] \[Equal] 1\)]], ". " }], "Text"], Cell[BoxData[ \(evalMask[s_] := Module[{leng = Exponent[s, x], n, \[ScriptN], eqs}, \[IndentingNewLine]n = Function[x, Sum[\[ScriptN][i] x\^\(i - 1\), {i, leng - 1}]]; \[IndentingNewLine]eqs = CoefficientList[s*n[x] - \ x\ n[x\^2], {x}]; \[IndentingNewLine]n[ x] /. \(Solve[{eqs\[LeftDoubleBracket] Range[2, Length[eqs], 2]\[RightDoubleBracket] \[Equal] 0, n[1] \[Equal] 1}]\)\[LeftDoubleBracket]1\[RightDoubleBracket]]\)], "Input",\ InitializationCell->True, CellTags->"EQN compute interpolation mask"], Cell[BoxData[{ \(\(cubic = \(1\/8\) \((1 + x)\)\^4;\)\), "\[IndentingNewLine]", \(\(fourPt = \(-1\)\/16 + \(9\/16\) x\^2 + x\^3 + \(9\/16\) x\^4 - \(1\/16\) x\^6;\)\)}], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[BoxData[{ \(evalMask[cubic]\), "\[IndentingNewLine]", \(evalMask[fourPt]\)}], "Input"], Cell[BoxData[ \(1\/6 + \(2\ x\)\/3 + x\^2\/6\)], "Output"], Cell[BoxData[ \(x\^2\)], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Compute exact derivative masks for uniform schemes", "Subsubsection"], Cell[BoxData[ \(derivMask[s_, k_] := Expand[\(\((1 - x)\)\^k\) evalMask[Simplify[\(\(2\^k\) s\)\/\((1 + x)\)\^k]]]\)], "Input", InitializationCell->True], Cell["Compute exact masks for cubic B\[Hyphen]splines", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(derivMask[cubic, 0]\), "\[IndentingNewLine]", \(derivMask[cubic, 1]\), "\[IndentingNewLine]", \(derivMask[cubic, 2]\)}], "Input"], Cell[BoxData[ \(1\/6 + \(2\ x\)\/3 + x\^2\/6\)], "Output"], Cell[BoxData[ \(1\/2 - x\^2\/2\)], "Output"], Cell[BoxData[ \(1 - 2\ x + x\^2\)], "Output"] }, Open ]], Cell["Compute exact derivative masks for four point rule", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(derivMask[fourPt, 0]\), "\[IndentingNewLine]", \(derivMask[fourPt, 1]\)}], "Input"], Cell[BoxData[ \(x\^2\)], "Output"], Cell[BoxData[ \(\(-\(1\/12\)\) + \(2\ x\)\/3 - \(2\ x\^3\)\/3 + x\^4\/12\)], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Exact inner products", "Subsection", CellTags->"exact inner prod"], Cell[CellGroupData[{ Cell["Computing the inner product mask for uniform schemes", "Subsubsection"], Cell[TextData[{ "The function ", Cell[BoxData[ \(ipMask\)]], " takes two subdivision masks ", Cell[BoxData[ \(s[x]\)]], " and ", Cell[BoxData[ \(t[x]\)]], " and computes the inner product mask for the ", Cell[BoxData[ \(i\)]], "th and ", Cell[BoxData[ \(j\)]], "th derivatives of the associated scaling functions." }], "Text"], Cell[BoxData[ \(ipMask[s_, t_, {i_, j_}] := With[{rT = \((t /. {x \[Rule] 1\/x})\) x\^Exponent[t, x]}, \[IndentingNewLine]Expand[\(\((1 - x)\)\^i\) \(\((x - 1)\)\^j\) evalMask[ Simplify[\(1\/2\) \(\(\(2\^i\) s\)\/\((1 + x)\)\^i\) \(\(2\^j\) rT\)\/\((1 + \ x)\)\^j]]]]\)], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[BoxData[ \(ipMask[cubic, cubic, {0, 0}]\)], "Input"], Cell[BoxData[ \(1\/5040 + x\/42 + \(397\ x\^2\)\/1680 + \(151\ x\^3\)\/315 + \(397\ x\^4\)\/1680 \ + x\^5\/42 + x\^6\/5040\)], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Evaluation of inner products for uniform schemes", "Subsubsection"], Cell[TextData[{ Cell[BoxData[ \(evalInner\)]], " takes a mask ", Cell[BoxData[ \(e\)]], " (as a list of coefficients) and two list of coefficients ", Cell[BoxData[ \(p\)]], " and ", Cell[BoxData[ \(q\)]], " and returns ", Cell[BoxData[ \(\(p\^T\) E\ q\)]], " where ", Cell[BoxData[ \(E\)]], " is the circulant matrix defined by mask ", Cell[BoxData[ \(e\)]] }], "Text"], Cell[BoxData[ \(evalInner[e_, p_, q_] := With[{ec = CoefficientList[e, x]}, \[IndentingNewLine]q . ListConvolve[ec, p, \(Length[ec] + 1\)\/2]]\)], "Input", InitializationCell->True] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Example: Exact enclosed area for parametric curves", "Subsection"], Cell[CellGroupData[{ Cell["Exact enclosed area for the four\[Hyphen]point curves", "Subsubsection"], Cell[TextData[{ "Given a closed parametric curves ", Cell[BoxData[ \({\[ScriptP][\[ScriptX]], \[ScriptQ][\[ScriptX]]}\)]], ", the length of this curve correponds to the integral" }], "Text"], Cell[BoxData[ RowBox[{\(1\/2\), RowBox[{\(\[Integral]\_\[CapitalOmega]\), RowBox[{ RowBox[{"Det", "[", RowBox[{"(", GridBox[{ {\(\[ScriptP][\[ScriptX]]\), \(\(\[ScriptP]\^\[Prime]\)[\ \[ScriptX]]\)}, {\(\[ScriptQ][\[ScriptX]]\), \(\(\[ScriptQ]\^\[Prime]\)[\ \[ScriptX]]\)} }], ")"}], "]"}], \(\(\[DifferentialD]\[ScriptX]\)\(\ \)\(.\)\)}]}]}]], \ "Equation"], Cell[TextData[{ "For example, the area of circle of radius ", Cell[BoxData[ \(r\)]], " is" }], "Text"], Cell[BoxData[ \(circle[\[Theta]_] := r {Cos[\[Theta]], Sin[\[Theta]]}\)], "Input"], Cell[BoxData[ RowBox[{\(area[\[ScriptP]_, {min_, max_}]\), ":=", RowBox[{\(1\/2\), RowBox[{\(\[Integral]\_min\%max\), RowBox[{ RowBox[{"Det", "[", RowBox[{"{", RowBox[{\(\[ScriptP][\[ScriptX]]\), ",", RowBox[{ SuperscriptBox["\[ScriptP]", "\[Prime]", MultilineFunction->None], "[", "\[ScriptX]", "]"}]}], "}"}], "]"}], \(\[DifferentialD]\[ScriptX]\)}]}]}]}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ \(area[circle, {0, 2 \[Pi]}]\)], "Input"], Cell[BoxData[ \(\[Pi]\ r\^2\)], "Output"] }, Open ]], Cell["Compute enclosed area mask for cubic B\[Hyphen]spline", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(cubicArea = ipMask[cubic, cubic, {0, 1}]\)], "Input"], Cell[BoxData[ \(\(-\(1\/720\)\) - \(7\ x\)\/90 - \(49\ x\^2\)\/144 + \(49\ x\^4\)\/144 \ + \(7\ x\^5\)\/90 + x\^6\/720\)], "Output"] }, Open ]], Cell["\<\ Define exact unit square for four point scheme via five fold control points \ and compute its enclosed area\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(evalInner[ cubicArea, \[IndentingNewLine]{0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0}, \[IndentingNewLine]{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}]\)], "Input"], Cell[BoxData[ \(1\)], "Output"] }, Open ]], Cell["\<\ Compute approximate area of unit circle, note that approximation leads to \ substantial error\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(evalInner[ cubicArea, \[IndentingNewLine]Table[Cos[\(2 \[Pi]\ i\)\/80], {i, 80}] // N, \[IndentingNewLine]Table[Sin[\(2 \[Pi]\ i\)\/80], {i, 80}] // N]\)], "Input"], Cell[BoxData[ \(3.135139317714538`\)], "Output"] }, Open ]], Cell["Compute enclosed area mask for four point rule", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(fourPtArea = ipMask[fourPt, fourPt, {0, 1}]\)], "Input", CellTags->"fourPtArea"], Cell[BoxData[ \(1\/665280 + \(4\ x\)\/10395 - \(481\ x\^2\)\/73920 + \(731\ \ x\^3\)\/6930 - \(3659\ x\^4\)\/5280 + \(3659\ x\^6\)\/5280 - \(731\ \ x\^7\)\/6930 + \(481\ x\^8\)\/73920 - \(4\ x\^9\)\/10395 - x\^10\/665280\)], "Output"] }, Open ]], Cell["\<\ Define exact unit square for four point scheme via five fold control points, \ check normalization\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(evalInner[ fourPtArea, \[IndentingNewLine]{0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0}, \[IndentingNewLine]{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}]\)], "Input"], Cell[BoxData[ \(1\)], "Output"] }, Open ]], Cell["\<\ Note much better accuracy of approximation of interpolating scheme for circle\ \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(ListPlot[ Table[{n, evalInner[ fourPtArea, \[IndentingNewLine]Table[ Cos[\(2 \[Pi]\ i\)\/n], {i, n}] // N, \[IndentingNewLine]Table[Sin[\(2 \[Pi]\ i\)\/n], {i, n}] // N]}, {n, 8, 20}], PlotJoined \[Rule] True, PlotRange \[Rule] All]\)], "Input", CellTags->"FIG circle area"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Subdivision for natural cubic splines", "Section"], Cell[CellGroupData[{ Cell["A variational formulation of cubic splines", "Subsection", CellTags->"SUBSEC math model"], Cell["\<\ Definition of the variational energy functional for natural cubic splines.\ \>", "Text"], Cell[BoxData[ RowBox[{\(\[ScriptCapitalE][\[ScriptP]_, n_]\), ":=", RowBox[{ StyleBox[\(\[Integral]\_0\%n\), ScriptLevel->0], RowBox[{ SuperscriptBox[ RowBox[{ StyleBox["(", ScriptLevel->0], RowBox[{ SuperscriptBox["\[ScriptP]", "\[Prime]\[Prime]", MultilineFunction->None], "[", "\[ScriptX]", "]"}], ")"}], "2"], "\[ThinSpace]", \(\[DifferentialD]\[ScriptX]\)}]}]}]], \ "Input", InitializationCell->True, CellTags->"EQN natcub energy"], Cell[CellGroupData[{ Cell[BoxData[ \(\[ScriptCapitalE][Sin, 2 \[Pi]]\)], "Input"], Cell[BoxData[ \(\[Pi]\)], "Output"] }, Open ]], Cell[BoxData[ \(<< Calculus`VariationalMethods`\)], "Input", InitializationCell->True], Cell["\<\ Compute the Euler\[Hyphen]Lagrange equation for natural cubic splines. \ Observe that cubic polynomials satisfy these equations.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"EulerEquations", "[", RowBox[{ SuperscriptBox[ RowBox[{ StyleBox["(", ScriptLevel->0], RowBox[{ SuperscriptBox["\[ScriptP]", "\[Prime]\[Prime]", MultilineFunction->None], "[", "\[ScriptX]", "]"}], ")"}], "2"], ",", \(\[ScriptP][\[ScriptX]]\), ",", "\[ScriptX]"}], "]"}]], "Input", CellTags->"EQN natcub pde"], Cell[BoxData[ RowBox[{ RowBox[{"2", " ", RowBox[{ SuperscriptBox["\[ScriptP]", TagBox[\((4)\), Derivative], MultilineFunction->None], "[", "\[ScriptX]", "]"}]}], "==", "0"}]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["A finite element scheme for natural cubic splines", "Subsection", CellTags->"SUBSEC natural cubic inner product"], Cell[CellGroupData[{ Cell["Plots of finite element basis functions", "Subsubsection"], Cell["\<\ Use truncated quadratic B\[Hyphen]spline basis functions as finite element \ basis functions for variational functional above.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Module[{\[ScriptN]}, \[ScriptN][\[ScriptX]_] = 1\/2\ \((\(-\((2 + \[ScriptX])\)\^2\)\ UnitStep[\(-2\) - \[ScriptX]] \ + 3\ \((1 + \[ScriptX])\)\^2\ UnitStep[\(-1\) - \[ScriptX]] + UnitStep[1 - \[ScriptX]] - 2\ \[ScriptX]\ UnitStep[ 1 - \[ScriptX]] + \[ScriptX]\^2\ UnitStep[1 - \[ScriptX]] - 3\ \[ScriptX]\^2\ UnitStep[\(-\[ScriptX]\)])\); \n Show[GraphicsArray[\[IndentingNewLine]{Plot[{If[\[ScriptX] \ \[GreaterEqual] 0, \[ScriptN][\[ScriptX]], 0], If[\[ScriptX] \[GreaterEqual] 0, \[ScriptN][\[ScriptX] - 1], 0], \[ScriptN][\[ScriptX] - 2], \[ScriptN][\[ScriptX] - 3], \[ScriptN][\[ScriptX] - 4]}, {\[ScriptX], \(-1\), 5}, \[IndentingNewLine]PlotRange \[Rule] {0, 1}], \[IndentingNewLine]Plot[{If[\[ScriptX] \[GreaterEqual] 0, \[ScriptN][2 \[ScriptX]], 0], If[\[ScriptX] \[GreaterEqual] 0, \[ScriptN][ 2 \[ScriptX] - 1], 0], \[ScriptN][ 2 \[ScriptX] - 2], \[ScriptN][ 2 \[ScriptX] - 3], \[ScriptN][ 2 \[ScriptX] - 4], \[IndentingNewLine]\[ScriptN][ 2 \[ScriptX] - 5], \[ScriptN][ 2 \[ScriptX] - 6], \[ScriptN][ 2 \[ScriptX] - 7], \[ScriptN][ 2 \[ScriptX] - 8]}, {\[ScriptX], \(-1\), 5}, PlotRange \[Rule] {0, 1}]}]]]\)], "Input", CellTags->"FIG finite element plot"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Solve for inner product matrix", "Subsubsection"], Cell[TextData[{ "Construct inner product matrix ", Cell[BoxData[ \(E\)]], " from finite element basis with subdivision matrix ", Cell[BoxData[ \(S\&^\)]], " for the finite element basis functions. In particular, we are interested \ in the inner product matrix ", Cell[BoxData[ \(E\)]], " such that" }], "Text"], Cell[BoxData[ \(E\[LeftDoubleBracket]i, j\[RightDoubleBracket] = \[Integral]\_0\%\[Infinity]\( \ \[ScriptN]\^\((2)\)\)[\[ScriptX] - i] \(\[ScriptN]\^\((2)\)\)[\[ScriptX] - j] \[DifferentialD]\[ScriptX]\)], "NumberedEquation"], Cell[TextData[{ "Since inner product uses second derivatices, use ", Cell[BoxData[ \(\[ScriptCapitalC]\^1\)]], " quadratic B\[Hyphen]splines with local subdivision matrix ", Cell[BoxData[ \(S\&^\)]] }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{\(S\&^\), "=", RowBox[{\(1\/4\), RowBox[{"(", GridBox[{ {"3", "1", "0"}, {"1", "3", "0"}, {"0", "3", "1"}, {"0", "1", "3"}, {"0", "0", "3"}, {"0", "0", "1"} }], ")"}]}]}], ";"}]], "Input"], Cell[TextData[{ "Define rules for creating unknown entries in inner product matrix. The \ function ", Cell[BoxData[ \(idx\)]], " numbers entries of unknown matrix ", Cell[BoxData[ \(unkE\)]], ". Construct energy matrix with unknowns, allow for two rows of special \ ruls (i.e. ", Cell[BoxData[ \(i\)]], " and ", Cell[BoxData[ \(j\)]], " start ranging from ", Cell[BoxData[ \(\(-2\)\)]], ")" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((unkE = Module[{idx}, \[IndentingNewLine]idx[\(-1\), \(-1\)] = \(-1\); \ \[IndentingNewLine]idx[\(-2\), \(-1\)] = \(-2\); \ \[IndentingNewLine]idx[\(-1\), \(-2\)] = \(-3\); \ \[IndentingNewLine]idx[\(-2\), \(-2\)] = \(-4\); \[IndentingNewLine]idx[i_, j_] := Abs[j - i]; \[IndentingNewLine]Table[ If[idx[i, j] > 2, 0, e[idx[i, j]]], {i, \(-2\), 3}, {j, \(-2\), 3}]])\) // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(e[\(-4\)]\), \(e[\(-2\)]\), \(e[2]\), "0", "0", "0"}, {\(e[\(-3\)]\), \(e[\(-1\)]\), \(e[1]\), \(e[2]\), "0", "0"}, {\(e[2]\), \(e[1]\), \(e[0]\), \(e[1]\), \(e[2]\), "0"}, {"0", \(e[2]\), \(e[1]\), \(e[0]\), \(e[1]\), \(e[2]\)}, {"0", "0", \(e[2]\), \(e[1]\), \(e[0]\), \(e[1]\)}, {"0", "0", "0", \(e[2]\), \(e[1]\), \(e[0]\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Solve for unknown entries of ", Cell[BoxData[ \(unkE\)]], ", observe that I have sized the matrice ", Cell[BoxData[ \(S\&^\)]], " and ", Cell[BoxData[ \(unkE\)]], " so that all row/column products of finite matrices agree with infinite \ version." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(unkE /. \(Solve[{Transpose[S\&^] . unkE . S\&^ \[Equal] \(1\/8\) unkE\[LeftDoubleBracket]{1, 2, 3}, {1, 2, 3}\[RightDoubleBracket], e[2] \[Equal] 1}]\)\[LeftDoubleBracket]1\[RightDoubleBracket] // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(-2\), "1", "0", "0", "0"}, {\(-2\), "5", \(-4\), "1", "0", "0"}, {"1", \(-4\), "6", \(-4\), "1", "0"}, {"0", "1", \(-4\), "6", \(-4\), "1"}, {"0", "0", "1", \(-4\), "6", \(-4\)}, {"0", "0", "0", "1", \(-4\), "6"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Implementation of finite inner product matrix", "Subsubsection"], Cell[TextData[{ "Define a function ", Cell[BoxData[ \(EE[k, n]\)]], " that constructs the energy matrix on the interval ", Cell[BoxData[ \(\([0, n]\)\)]], " for the resolution ", Cell[BoxData[ \(\(1\/2\^k\) \[DoubleStruckCapitalZ]\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(EE[k_, n_] := \[IndentingNewLine]With[{diff = 4\^k*With[{row = Join[{1, \(-2\), 1}, Table[0, {\(2\^k\) n - 2}]]}, \n\t\t\t\tTable[ RotateRight[row, i], {i, 0, \(2\^k\) n - 2}]]}, \(\((1\/2)\)\^k\) Transpose[diff] . diff]\)], "Input", InitializationCell->True], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(row\)\" is similar to \ existing symbol \"\!\(Row\)\"."\)], "Message"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(EE[0, 6] // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(-2\), "1", "0", "0", "0", "0"}, {\(-2\), "5", \(-4\), "1", "0", "0", "0"}, {"1", \(-4\), "6", \(-4\), "1", "0", "0"}, {"0", "1", \(-4\), "6", \(-4\), "1", "0"}, {"0", "0", "1", \(-4\), "6", \(-4\), "1"}, {"0", "0", "0", "1", \(-4\), "5", \(-2\)}, {"0", "0", "0", "0", "1", \(-2\), "1"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["A multi\[Hyphen]scale relation for natural cubic splines", "Subsection"], Cell["See end of next section for plot of figure 6.4", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Subdivision rules for natural cubic splines", "Subsection", CellTags->"SUBSEC compute S"], Cell[CellGroupData[{ Cell["Solve for subdivision matrix", "Subsubsection"], Cell[TextData[{ "Proceed to use variational approach for construct natural cubic splines \ via ", Cell[BoxData[ \(E . S \[Equal] \(1\/8\) U . E\)]], " where ", Cell[BoxData[ \(U\)]], " is upsampling matrix. " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((truncE = \(EE[0, 6]\)\[LeftDoubleBracket]{1, 2, 3, 4, 5}\[RightDoubleBracket])\) // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(-2\), "1", "0", "0", "0", "0"}, {\(-2\), "5", \(-4\), "1", "0", "0", "0"}, {"1", \(-4\), "6", \(-4\), "1", "0", "0"}, {"0", "1", \(-4\), "6", \(-4\), "1", "0"}, {"0", "0", "1", \(-4\), "6", \(-4\), "1"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Define function that upsamples a list ", Cell[BoxData[ \(l\)]], "." }], "Text"], Cell[BoxData[ \(upsample[l_] := Table[If[OddQ[i], l\[LeftDoubleBracket]\(i + 1\)\/2\[RightDoubleBracket], 0*l\[LeftDoubleBracket]1\[RightDoubleBracket]], {i, 2 Length[l] - 1}]\)], "Input", InitializationCell->True, CellTags->"EQN upsampling"], Cell[TextData[{ "Define upsampled version of ", Cell[BoxData[ \(truncE\)]], " of appropriate size" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((uE = upsample[ truncE\[LeftDoubleBracket]{1, 2, 3}, {1, 2, 3}\[RightDoubleBracket]])\) // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(-2\), "1"}, {"0", "0", "0"}, {\(-2\), "5", \(-4\)}, {"0", "0", "0"}, {"1", \(-4\), "6"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Define indexing rules for unknown entries in ", Cell[BoxData[ \(unkS\)]], ". Note that I used different rules than for ", Cell[BoxData[ \(unkE\)]], ". ", "Allow special rules for first two rows. ", StyleBox["Using the same symmetry rules as for ", FontColor->RGBColor[1, 0, 0]], Cell[BoxData[ \(unkE\)], FontColor->RGBColor[1, 0, 0]], StyleBox[" would not allow for local solution.", FontColor->RGBColor[1, 0, 0]] }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((unkS = Module[{idx}, \[IndentingNewLine]idx[\(-2\), \(-1\)] = \(-1\); \ \[IndentingNewLine]idx[\(-3\), \(-1\)] = \(-3\); \ \[IndentingNewLine]idx[\(-3\), \(-3\)] = \(-4\); \ \[IndentingNewLine]idx[\(-2\), \(-3\)] = \(-2\); \[IndentingNewLine]idx[i_, j_] := Abs[j - i]; \[IndentingNewLine]Table[ If[idx[i, j] < 3, s[idx[i, j]], 0], {i, \(-3\), 3}, {j, \(-3\), 1, 2}]])\) // MatrixForm\)], "Input"], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(unkS\)\" is similar to \ existing symbol \"\!\(unkE\)\"."\)], "Message"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(s[\(-4\)]\), \(s[\(-3\)]\), "0"}, {\(s[\(-2\)]\), \(s[\(-1\)]\), "0"}, {\(s[2]\), \(s[0]\), \(s[2]\)}, {"0", \(s[1]\), \(s[1]\)}, {"0", \(s[2]\), \(s[0]\)}, {"0", "0", \(s[1]\)}, {"0", "0", \(s[2]\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Solve for subdivision matrix ", Cell[BoxData[ \(S\)]], ", observe that I have sized the matrice ", Cell[BoxData[ \(S\)]], " and ", Cell[BoxData[ \(EE\)]], " so that all row/column products of finite matrices agree with infinite \ version." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((unkS /. \(Solve[ truncE . unkS\ - \(1\/8\) uE\[LeftDoubleBracket]{1, 2, 3, 4, 5}, {1, 2, 3}\[RightDoubleBracket] \[Equal] 0]\)\[LeftDoubleBracket]1\[RightDoubleBracket])\) // MatrixForm\)], "Input", CellTags->"subd template"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", "0", "0"}, {\(1\/2\), \(1\/2\), "0"}, {\(1\/8\), \(3\/4\), \(1\/8\)}, {"0", \(1\/2\), \(1\/2\)}, {"0", \(1\/8\), \(3\/4\)}, {"0", "0", \(1\/2\)}, {"0", "0", \(1\/8\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Implementation of finite subdivision matrix", "Subsubsection"], Cell[TextData[{ "Implement subdivision directly. The function ", Cell[BoxData[ \(SS\)]], " takes a list of points ", Cell[BoxData[ \(p\)]], " and subdivides them directly." }], "Text"], Cell[BoxData[ \(SS[p_] := With[{n = Length[p] - 1}, \n\t Table[\n\t\tWhich[\n\t\t\ti == 0, p\[LeftDoubleBracket]1\[RightDoubleBracket], \n\t\t\ti == 2 n, p\[LeftDoubleBracket]n + 1\[RightDoubleBracket], \n\t\t\tOddQ[ i], \(1\/2\) p\[LeftDoubleBracket]\(i + 1\)\/2\[RightDoubleBracket] + \ \(1\/2\) p\[LeftDoubleBracket]\(i + 3\)\/2\[RightDoubleBracket], \n\t\t\t\ EvenQ[i], \(1\/8\) p\[LeftDoubleBracket]i\/2\[RightDoubleBracket] + \(3\/4\) p\[LeftDoubleBracket]i\/2 + 1\[RightDoubleBracket] + \(1\/8\) p\[LeftDoubleBracket]i\/2 + 2\[RightDoubleBracket]], \n\t\t\ {i, 0, 2 n}]]\)], "Input", InitializationCell->True], Cell["Plot figure 6.4", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Module[{p0 = {{0, 1}, {1, 3}, {2, 2}, {3, 5}, {4, 4}}, p1, p2, p3}, \[IndentingNewLine]p1 = SS[p0]; \[IndentingNewLine]p2 = SS[p1]; \[IndentingNewLine]p3 = SS[p2]; \[IndentingNewLine]Show[ GraphicsArray[\[IndentingNewLine]{{plotCoeff[p0], plotCoeff[p1], plotCoeff[p2], plotCoeff[p3]}, {\[IndentingNewLine]plotCoeff[ Transpose[{\(Transpose[ p0]\)\[LeftDoubleBracket]1\[RightDoubleBracket], energy[0, 4] . \(Transpose[ p0]\)\[LeftDoubleBracket]2\[RightDoubleBracket]}], \ \[IndentingNewLine]PlotRange \[Rule] {\(-15\), 15}], \[IndentingNewLine]plotCoeff[ Transpose[{\(Transpose[ p1]\)\[LeftDoubleBracket]1\[RightDoubleBracket], energy[1, 4] . \(Transpose[ p1]\)\[LeftDoubleBracket]2\[RightDoubleBracket]}], \ \[IndentingNewLine]PlotRange \[Rule] {\(-15\), 15}], \[IndentingNewLine]plotCoeff[ Transpose[{\(Transpose[ p2]\)\[LeftDoubleBracket]1\[RightDoubleBracket], energy[2, 4] . \(Transpose[ p2]\)\[LeftDoubleBracket]2\[RightDoubleBracket]}], \ \[IndentingNewLine]PlotRange \[Rule] {\(-15\), 15}], \[IndentingNewLine]plotCoeff[ Transpose[{\(Transpose[ p3]\)\[LeftDoubleBracket]1\[RightDoubleBracket], energy[3, 4] . \(Transpose[ p3]\)\[LeftDoubleBracket]2\[RightDoubleBracket]}], PlotRange \[Rule] {\(-15\), 15}]}}]]]\)], "Input", CellTags->"FIG differences are zero"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Show[ GraphicsArray[\[IndentingNewLine]{{plotCoeff[ Nest[SS, {{0.0729113, 0.461168}, {0.724225, 0.11953}, {0.720686, 0.847611}, {0.048133, 0.130731}, {0.844577, 0.293149}}, 0], PlotRange \[Rule] {{0, 1}, {0, 1}}], \[IndentingNewLine]plotCoeff[ Nest[SS, {{0.0729113, 0.461168}, {0.724225, 0.11953}, {0.720686, 0.847611}, {0.048133, 0.130731}, {0.844577, 0.293149}}, 1], PlotRange \[Rule] {{0, 1}, {0, 1}}]}, \[IndentingNewLine]{plotCoeff[ Nest[SS, {{0.0729113, 0.461168}, {0.724225, 0.11953}, {0.720686, 0.847611}, {0.048133, 0.130731}, {0.844577, 0.293149}}, 2], PlotRange \[Rule] {{0, 1}, {0, 1}}], \[IndentingNewLine]plotCoeff[ Nest[SS, {{0.0729113, 0.461168}, {0.724225, 0.11953}, {0.720686, 0.847611}, {0.048133, 0.130731}, {0.844577, 0.293149}}, 3], PlotRange \[Rule] {{0, 1}, {0, 1}}]}}]]\)], "Input"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Minimization of the variational scheme", "Section"], Cell[CellGroupData[{ Cell["Interpolation with natural cubic splines", "Subsection"], Cell[CellGroupData[{ Cell["Solve for interpolation matrix", "Subsubsection"], Cell[TextData[{ " Use the recurrence ", Cell[BoxData[ \(\(U\^T\) N\ S\ = N\)]], " to solve for entries in ", Cell[BoxData[ \(N\)]], ". ", Cell[BoxData[ \(U\^T\)]], " is computed via the function ", Cell[BoxData[ \(downSample\)]], "." }], "Text"], Cell[BoxData[ \(downsample[l_] := Table[l\[LeftDoubleBracket]i + 1\[RightDoubleBracket], {i, 0, Length[l] - 1, 2}]\)], "Input", InitializationCell->True], Cell[TextData[{ "Symbolic rules for interpolation matrix ", Cell[BoxData[ \(N\)]], ". Allow special rules for first two rows" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((unkN = Module[{idx}, \[IndentingNewLine]idx[\(-1\), \(-1\)] = \(-5\); \ \[IndentingNewLine]idx[\(-1\), 0] = \(-4\); \[IndentingNewLine]idx[ 0, \(-1\)] = \(-3\); \[IndentingNewLine]idx[0, 0] = \(-2\); \[IndentingNewLine]idx[0, 1] = \(-1\); \[IndentingNewLine]idx[i_, j_] := Abs[j - i]; \[IndentingNewLine]Table[ If[idx[i, j] < 2, n[idx[i, j]], 0], {i, \(-1\), 4}, {j, \(-1\), 5}]])\) // MatrixForm\)], "Input"], Cell[BoxData[ \(General::"spell" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(unkN\)\" is similar to \ existing symbols \!\({unkE, unkS}\)."\)], "Message"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(n[\(-5\)]\), \(n[\(-4\)]\), "0", "0", "0", "0", "0"}, {\(n[\(-3\)]\), \(n[\(-2\)]\), \(n[\(-1\)]\), "0", "0", "0", "0"}, {"0", \(n[1]\), \(n[0]\), \(n[1]\), "0", "0", "0"}, {"0", "0", \(n[1]\), \(n[0]\), \(n[1]\), "0", "0"}, {"0", "0", "0", \(n[1]\), \(n[0]\), \(n[1]\), "0"}, {"0", "0", "0", "0", \(n[1]\), \(n[0]\), \(n[1]\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell["Solve for unknown entries via linear algabra", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((unkN /. \(Solve[{\[IndentingNewLine]unkN . {1, 1, 1, 1, 1, 1, 1} \[Equal] {1, 1, 1, 1, 1, 1}, \[IndentingNewLine]downsample[ unkN . \(SS[IdentityMatrix[5]]\)\[LeftDoubleBracket]{1, 2, 3, 4, 5, 6, 7}, {1, 2, 3}\[RightDoubleBracket]] \[Equal] unkN\[LeftDoubleBracket]{1, 2, 3}, {1, 2, 3}\[RightDoubleBracket]}]\)\[LeftDoubleBracket]1\ \[RightDoubleBracket])\) // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", "0", "0", "0", "0", "0", "0"}, {\(1\/6\), \(2\/3\), \(1\/6\), "0", "0", "0", "0"}, {"0", \(1\/6\), \(2\/3\), \(1\/6\), "0", "0", "0"}, {"0", "0", \(1\/6\), \(2\/3\), \(1\/6\), "0", "0"}, {"0", "0", "0", \(1\/6\), \(2\/3\), \(1\/6\), "0"}, {"0", "0", "0", "0", \(1\/6\), \(2\/3\), \(1\/6\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Implementation of finite interpolation matrix", "Subsubsection"], Cell[TextData[{ "Construct the ", Cell[BoxData[ \(n\[Times]n\)]], " interpolation matrix for natural cubic splines" }], "Text"], Cell[BoxData[ \(NN[n_] := Table[\[IndentingNewLine]Which[\[IndentingNewLine]i \[Equal] j \[Equal] 0 || i \[Equal] j \[Equal] n, 1, \[IndentingNewLine]i \[Equal] j, 2\/3, \[IndentingNewLine]Abs[i - j] \[Equal] 1 && i > 0 && i < n, 1\/6, \[IndentingNewLine]True, 0], \[IndentingNewLine]{i, 0, n}, {j, 0, n}]\)], "Input", InitializationCell->True], Cell["An example", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(NN[6] // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", "0", "0", "0", "0", "0", "0"}, {\(1\/6\), \(2\/3\), \(1\/6\), "0", "0", "0", "0"}, {"0", \(1\/6\), \(2\/3\), \(1\/6\), "0", "0", "0"}, {"0", "0", \(1\/6\), \(2\/3\), \(1\/6\), "0", "0"}, {"0", "0", "0", \(1\/6\), \(2\/3\), \(1\/6\), "0"}, {"0", "0", "0", "0", \(1\/6\), \(2\/3\), \(1\/6\)}, {"0", "0", "0", "0", "0", "0", "1"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Compute a set of control points ", Cell[BoxData[ \(p\_0\)]], " for a natural cubic spline interpolating ", Cell[BoxData[ RowBox[{"(", GridBox[{ {"0", "0"}, {"1", "2"}, {"2", "2"}, {"3", "3"}, {"4", "1"} }], ")"}]]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{\(Inverse[NN[4]]\), ".", RowBox[{"(", GridBox[{ {"0", "0"}, {"1", "2"}, {"2", "2"}, {"3", "3"}, {"4", "1"} }], ")"}]}], "//", "MatrixForm"}]], "Input", CellTags->"inv interp"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0"}, {"1", \(149\/56\)}, {"2", \(19\/14\)}, {"3", \(219\/56\)}, {"4", "1"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"sub", "=", RowBox[{"(", "\[NoBreak]", GridBox[{ {"1.60308`", "0.494123`"}, {"0.753482`", "0.494123`"}, {"0.753482`", "0.344159`"}, {"1.60308`", "0.331662`"}, {"1.60308`", "0.169201`"}, {"0.676246`", "0.13171`"}, {"2.18234`", "0.156704`"}, {"2.33682`", "0.50662`"}, {"2.64576`", "0.13171`"}, {"3.18641`", "0.494123`"}, {"3.18641`", "0.144207`"}, {"4.22909`", "0.144207`"}, {"4.15186`", "0.944016`"}, {"4.07462`", "0.494123`"}, {"4.96283`", "0.494123`"}, {"4.8856`", "0.144207`"}, {"4.26771`", "0.144207`"} }], "\[NoBreak]", ")"}]}], "}"}], ",", "\[IndentingNewLine]", \(Show[ GraphicsArray[\[IndentingNewLine]{plotCoeff[sub], plotCoeff[Nest[SS, Inverse[NN[16]] . sub, 4]]}]]\)}], "]"}]], "Input"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Exact inner products for the variational scheme", "Subsection"], Cell[TextData[{ "Compute exact energy for each component of the curve ", Cell[BoxData[ \(sub\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"sub", "=", RowBox[{"(", "\[NoBreak]", GridBox[{ {"1.60308`", "0.494123`"}, {"0.753482`", "0.494123`"}, {"0.753482`", "0.344159`"}, {"1.60308`", "0.331662`"}, {"1.60308`", "0.169201`"}, {"0.676246`", "0.13171`"}, {"2.18234`", "0.156704`"}, {"2.33682`", "0.50662`"}, {"2.64576`", "0.13171`"}, {"3.18641`", "0.494123`"}, {"3.18641`", "0.144207`"}, {"4.22909`", "0.144207`"}, {"4.15186`", "0.944016`"}, {"4.07462`", "0.494123`"}, {"4.96283`", "0.494123`"}, {"4.8856`", "0.144207`"}, {"4.26771`", "0.144207`"} }], "\[NoBreak]", ")"}]}], "}"}], ",", "\[IndentingNewLine]", \(Transpose[sub] . EE[0, 16] . NN[16] . sub\)}], "]"}], "//", "MatrixForm"}]], "Input", CellTags->"direct energy"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"8.026901704648013`", "0.12742023152400195`"}, {"0.1274202315240004`", "1.9783762882116662`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Compute approximate energy for each component of the curve ", Cell[BoxData[ \(sub\)]], " after four rounds of subdivision. Observe that as ", Cell[BoxData[ \(k \[Rule] \[Infinity]\)]], ", the energies are converging." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"sub", "=", RowBox[{"(", "\[NoBreak]", GridBox[{ {"1.60308`", "0.494123`"}, {"0.753482`", "0.494123`"}, {"0.753482`", "0.344159`"}, {"1.60308`", "0.331662`"}, {"1.60308`", "0.169201`"}, {"0.676246`", "0.13171`"}, {"2.18234`", "0.156704`"}, {"2.33682`", "0.50662`"}, {"2.64576`", "0.13171`"}, {"3.18641`", "0.494123`"}, {"3.18641`", "0.144207`"}, {"4.22909`", "0.144207`"}, {"4.15186`", "0.944016`"}, {"4.07462`", "0.494123`"}, {"4.96283`", "0.494123`"}, {"4.8856`", "0.144207`"}, {"4.26771`", "0.144207`"} }], "\[NoBreak]", ")"}]}], "}"}], ",", \(With[{k = 4}, Transpose[Nest[SS, sub, k]] . EE[k, 16] . Nest[SS, sub, k]]\)}], "]"}], "//", "MatrixForm"}]], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"8.056633267409492`", "0.12774266076400703`"}, {"0.12774266080039687`", "1.9883692681826246`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Multi\[Hyphen]resolution spaces for energy minimization", "Subsection"], Cell[TextData[{ "Build up control coefficients for a natural cubic spline that approximates \ ", Cell[BoxData[ \(Sin\)]] }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Module[{q}, \[IndentingNewLine]q[k_] := Inverse[N[NN[2\^\(2 + k\)]]] . Table[{i, Sin[i]}, {i, 0, 2 \[Pi], \[Pi]\/2\^\(1 + k\)}]; \[IndentingNewLine]Show[ GraphicsArray[\[IndentingNewLine]Reverse[{{plotCoeff[q[0]], ListPlot[Nest[SS, q[0], 5], PlotJoined \[Rule] True], plotCoeff[ Transpose[{\(Transpose[ q[1]]\)\[LeftDoubleBracket]1\[RightDoubleBracket], \ \(Transpose[q[1] - SS[q[0]]]\)\[LeftDoubleBracket]2\ \[RightDoubleBracket]}]]}, \[IndentingNewLine]{plotCoeff[q[1]], ListPlot[Nest[SS, q[1], 4], PlotJoined \[Rule] True], plotCoeff[ Transpose[{\(Transpose[ q[2]]\)\[LeftDoubleBracket]1\[RightDoubleBracket], \ \(Transpose[q[2] - SS[q[1]]]\)\[LeftDoubleBracket]2\ \[RightDoubleBracket]}]]}, \[IndentingNewLine]{plotCoeff[q[2]], ListPlot[Nest[SS, q[2], 3], PlotJoined \[Rule] True], plotCoeff[ Transpose[{\(Transpose[ q[3]]\)\[LeftDoubleBracket]1\[RightDoubleBracket], \ \(Transpose[q[3] - SS[q[2]]]\)\[LeftDoubleBracket]2\ \[RightDoubleBracket]}]]}, \[IndentingNewLine]{plotCoeff[q[3]], ListPlot[Nest[SS, q[3], 2], PlotJoined \[Rule] True], plotCoeff[ Transpose[{\(Transpose[ q[4]]\)\[LeftDoubleBracket]1\[RightDoubleBracket], \ \(Transpose[q[4] - SS[q[3]]]\)\[LeftDoubleBracket]2\ \[RightDoubleBracket]}]]}}]]]]\)], "Input", CellTags->"FIG energy multi res"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Subdivision for bounded biharmonic splines", "Section"], Cell[CellGroupData[{ Cell["A finite element scheme for bounded harmonic splines", "Subsection", CellTags->"SUBSEC bounded biharmonic inner product"], Cell[CellGroupData[{ Cell["Solve for harmonic inner product matrix", "Subsubsection"], Cell[TextData[{ "Construct subdivision matrix ", Cell[BoxData[ \(S\&^\)]], " for four direction quadratic box splines on bounded domain. Represent \ this matrix as a four dimensional tensor." }], "Text"], Cell[BoxData[ \(\(S\&^ = Table[makeCoeff[\(1\/2\) \((1 + x)\) \((1 + y)\) \((1 + x\ y)\), {{1 - 2 i, 6 - 2 i}, {1 - 2 j, 6 - 2 j}}, 0, x, y], {i, 0, 2}, {j, 0, 2}];\)\)], "Input", CellTags->"FIG finite element subdivision"], Cell[TextData[{ "Display a portion of ", Cell[BoxData[ \(S\&^\)]], " as a matrix of matrices" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[ Table[MatrixForm[ S\&^\[LeftDoubleBracket]i, j\[RightDoubleBracket]], {i, 3}, {j, 3}]]\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(1\/2\), "0", "0", "0", "0"}, {\(1\/2\), \(1\/2\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", \(1\/2\), "1", \(1\/2\), "0", "0"}, {"0", "0", \(1\/2\), \(1\/2\), "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", \(1\/2\), "1", \(1\/2\)}, {"0", "0", "0", "0", \(1\/2\), \(1\/2\)}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]}, { TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {\(1\/2\), "0", "0", "0", "0", "0"}, {"1", \(1\/2\), "0", "0", "0", "0"}, {\(1\/2\), \(1\/2\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {"0", \(1\/2\), \(1\/2\), "0", "0", "0"}, {"0", \(1\/2\), "1", \(1\/2\), "0", "0"}, {"0", "0", \(1\/2\), \(1\/2\), "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", \(1\/2\), \(1\/2\), "0"}, {"0", "0", "0", \(1\/2\), "1", \(1\/2\)}, {"0", "0", "0", "0", \(1\/2\), \(1\/2\)}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]}, { TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {\(1\/2\), "0", "0", "0", "0", "0"}, {"1", \(1\/2\), "0", "0", "0", "0"}, {\(1\/2\), \(1\/2\), "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", \(1\/2\), \(1\/2\), "0", "0", "0"}, {"0", \(1\/2\), "1", \(1\/2\), "0", "0"}, {"0", "0", \(1\/2\), \(1\/2\), "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", \(1\/2\), \(1\/2\), "0"}, {"0", "0", "0", \(1\/2\), "1", \(1\/2\)}, {"0", "0", "0", "0", \(1\/2\), \(1\/2\)} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "Construct the inner product matrix ", Cell[BoxData[ \(E\)]], " as a matrix with unknown entries" }], "Text"], Cell[BoxData[{ \(SetAttributes[e, Orderless]\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(unkE = Module[{idx}, \[IndentingNewLine]idx[0, 0] = \(-1\); \[IndentingNewLine]idx[i_, j_] := Abs[j - i]; \[IndentingNewLine]Table[ If[idx[i1, j1] < 2 && idx[i2, j2] < 2, e[idx[i1, j1], idx[i2, j2]], 0], {i1, 0, 5}, {i2, 0, 5}, {j1, 0, 5}, {j2, 0, 5}]];\)\)}], "Input"], Cell[TextData[{ "Display a portion of ", Cell[BoxData[ \(unkE\)]], " as a matrix of matrices" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Table[ unkE\[LeftDoubleBracket]i, j\[RightDoubleBracket] // MatrixForm, {i, 2}, {j, 2}] // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(e[\(-1\), \(-1\)]\), \(e[\(-1\), 1]\), "0", "0", "0", "0"}, {\(e[\(-1\), 1]\), \(e[1, 1]\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(e[\(-1\), 1]\), \(e[\(-1\), 0]\), \(e[\(-1\), 1]\), "0", "0", "0"}, {\(e[1, 1]\), \(e[0, 1]\), \(e[1, 1]\), "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]}, { TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(e[\(-1\), 1]\), \(e[1, 1]\), "0", "0", "0", "0"}, {\(e[\(-1\), 0]\), \(e[0, 1]\), "0", "0", "0", "0"}, {\(e[\(-1\), 1]\), \(e[1, 1]\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(e[1, 1]\), \(e[0, 1]\), \(e[1, 1]\), "0", "0", "0"}, {\(e[0, 1]\), \(e[0, 0]\), \(e[0, 1]\), "0", "0", "0"}, {\(e[1, 1]\), \(e[0, 1]\), \(e[1, 1]\), "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ Cell[BoxData[ \(flatten4D\)]], " takes the four dirmensional tensors ", Cell[BoxData[ \(unkE\)]], " and ", Cell[BoxData[ \(S\&^\)]], " and flattens then in matrices. ", Cell[BoxData[ \(unflatten\)]], " reverses this process." }], "Text"], Cell[BoxData[{ \(flatten4D[m_] := Flatten[Table[ Flatten[m\[LeftDoubleBracket]i, j\[RightDoubleBracket]], {i, \(Dimensions[ m]\)\[LeftDoubleBracket]1\[RightDoubleBracket]}, {j, \ \(Dimensions[m]\)\[LeftDoubleBracket]2\[RightDoubleBracket]}], 1]\), "\[IndentingNewLine]", \(unflatten[m_] := Partition[m, \@Length[m]]\)}], "Input", InitializationCell->True], Cell[TextData[{ "Solve for entries of ", Cell[BoxData[ \(unkE\)]], ", add auxiliary equations that force ", Cell[BoxData[ \(unkE\)]], " to annihilate linear terms" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(ansE = \(Solve[\[IndentingNewLine]{flatten4D[S\&^] . flatten4D[unkE] . Transpose[flatten4D[S\&^]] \[Equal] flatten4D[ unkE\[LeftDoubleBracket]{1, 2, 3}, {1, 2, 3}, {1, 2, 3}, {1, 2, 3}\[RightDoubleBracket]], \[IndentingNewLine]flatten4D[ unkE\[LeftDoubleBracket]{1, 2, 3}, {1, 2, 3}\[RightDoubleBracket]] . Flatten[Table[1, {i, 0, 5}, {j, 0, 5}]] \[Equal] 0, \[IndentingNewLine]Flatten[Table[1, {i, 0, 5}, {j, 0, 5}]] . flatten4D[ unkE\[LeftDoubleBracket]{1, 2, 3, 4, 5, 6}, {1, 2, 3, 4, 5, 6}, {1, 2, 3}, {1, 2, 3}\[RightDoubleBracket]] \[Equal] 0, e[0, 0] \[Equal] 4}]\)\[LeftDoubleBracket]1\[RightDoubleBracket]\)], "Input"], Cell[BoxData[ \({e[0, 0] \[Rule] 4, e[1, 1] \[Rule] 0, e[\(-1\), \(-1\)] \[Rule] 1, e[\(-1\), 1] \[Rule] \(-\(1\/2\)\), e[\(-1\), 0] \[Rule] 2, e[0, 1] \[Rule] \(-1\)}\)], "Output"] }, Open ]], Cell[TextData[{ "Construct finite inner product matrices for domain ", Cell[BoxData[ \(\([0, n]\)\^2\)]], ". ", Cell[BoxData[ \(matEE\)]], " uses the solution ", Cell[BoxData[ \(ansE\)]], " from the previous statement." }], "Text"], Cell[BoxData[ \(matEE[ n_] := \[IndentingNewLine]Module[{idx}, \[IndentingNewLine]idx[0, 0] = \(-1\); \[IndentingNewLine]idx[i_, j_] := Abs[j - i]; \[IndentingNewLine]Table[ If[idx[i1, j1] < 2 && idx[i2, j2] < 2, \[IndentingNewLine]Which[\[IndentingNewLine]i1 < n\/2 && i2 < n\/2, e[idx[i1, j1], idx[i2, j2]], \[IndentingNewLine]i1 < n\/2 && i2 \[GreaterEqual] n\/2, e[idx[i1, j1], idx[n - i2, n - j2]], \[IndentingNewLine]i1 \[GreaterEqual] n\/2 && i2 < n\/2, e[idx[n - i1, n - j1], idx[i2, j2]], \[IndentingNewLine]True, e[idx[n - i1, n - j1], idx[n - i2, n - j2]]], 0], \[IndentingNewLine]{i1, 0, n}, {i2, 0, n}, {j1, 0, n}, {j2, 0, n}] /. ansE]\)], "Input"], Cell[TextData[{ "Verify that normalization of inner product is correct. Compute energy of \ the function ", Cell[BoxData[ \(\[ScriptX]\)]], " on the domain ", Cell[BoxData[ \(\([0, 8]\)\^2\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Flatten[Table[i, {i, 0, 8}, {j, 0, 8}]] . flatten4D[matEE[8]] . Flatten[Table[i, {i, 0, 8}, {j, 0, 8}]]\)], "Input"], Cell[BoxData[ \(64\)], "Output"] }, Open ]], Cell["Display portion of innner product matrix at one corner", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(With[{foo = matEE[4]}, Table[foo\[LeftDoubleBracket]i, j\[RightDoubleBracket], {i, 1, 2}, {j, 1, 2}]] // MatrixForm\)], "Input", CellTags->"FIG compute inner product matrix"], Cell[BoxData[ InterpretationBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", \(-\(1\/2\)\), "0", "0", "0"}, {\(-\(1\/2\)\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], RowBox[{"(", "\[NoBreak]", GridBox[{ {\(-\(1\/2\)\), "2", \(-\(1\/2\)\), "0", "0"}, {"0", \(-1\), "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}]}, { RowBox[{"(", "\[NoBreak]", GridBox[{ {\(-\(1\/2\)\), "0", "0", "0", "0"}, {"2", \(-1\), "0", "0", "0"}, {\(-\(1\/2\)\), "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}], RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", \(-1\), "0", "0", "0"}, {\(-1\), "4", \(-1\), "0", "0"}, {"0", \(-1\), "0", "0", "0"}, {"0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0"} }], "\[NoBreak]", ")"}]} }], "\[NoBreak]", ")"}], MatrixForm[ {{{{1, Rational[ -1, 2], 0, 0, 0}, { Rational[ -1, 2], 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}, {{ Rational[ -1, 2], 2, Rational[ -1, 2], 0, 0}, {0, -1, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}}, {{{ Rational[ -1, 2], 0, 0, 0, 0}, {2, -1, 0, 0, 0}, { Rational[ -1, 2], 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}, {{ 0, -1, 0, 0, 0}, {-1, 4, -1, 0, 0}, {0, -1, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}}}]]], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Subdivision for harmonic splines on a quadrant", "Subsection"], Cell[CellGroupData[{ Cell["Construct of exact scheme", "Subsubsection"], Cell[TextData[{ "Code from chapter five for computing coefficients of subdivision mask ", Cell[BoxData[ \(s[x, y]\)]], " for harmonic splines" }], "Text"], Cell[BoxData[ \(ss[i_, 0] := \(ss[i, 0] = \(ss[\(-i\), 0] = \[IndentingNewLine]\(1\/\[Pi]\) NIntegrate[\(-Cos[i\ \[Alpha]]\)\ \((\(-2\) + Cos[\[Alpha]] + 4\ \@2\ \@\(1\/\(3 - Cos[\[Alpha]]\)\)\ \ Sin[\[Alpha]\/2]\^3)\), {\[Alpha], 0, 2 \[Pi]}] // FullSimplify\)\)\)], "Input", InitializationCell->True, CellTags->"comp mask"], Cell[TextData[{ "Given values for ", Cell[BoxData[ \(ss[i, 0]\)]], ", compute remaining values via difference equation ", Cell[BoxData[ \(l[x, y] s[x, y] \[Equal] l[x\^2, y\^2]\)]], "." }], "Text"], Cell[BoxData[ \(ss[ii_, jj_] := Module[{i = Abs[ii], j = Abs[jj], ll}, \[IndentingNewLine]ll[0, 0] = \(-4\); ll[2, 0] = 1; ll[\(-2\), 0] = 1; ll[0, 2] = 1; ll[0, \(-2\)] = 1; ll[_, _] = 0; \[IndentingNewLine]ss[i, j] = \(ss[\(-i\), j] = \(ss[i, \(-j\)] = \(ss[\(-i\), \(-j\)] = If[j \[Equal] 1, \[IndentingNewLine]\(1\/2\) \((4 ss[i, j - 1] - ss[i - 1, j - 1] - ss[i + 1, j - 1] + ll[i, j - 1])\), \[IndentingNewLine]4 ss[i, j - 1] - ss[i - 1, j - 1] - ss[i + 1, j - 1] - ss[i, j - 2] + ll[i, j - 1]] // Simplify\)\)\)]\)], "Input", InitializationCell->True], Cell[TextData[{ "Construct columns of subdivision matrix ", Cell[BoxData[ \(S\)]], " for bounded harmonic splines, ", Cell[BoxData[ \(S\[LeftDoubleBracket]i\_1, j\_1, i\_2, j\_2\[RightDoubleBracket]\)]], " entry has the form ", Cell[BoxData[ \(\[Sum]\(\(s\[LeftDoubleBracket]i\_1 \[PlusMinus] 2 i\_2, j\_1 \[PlusMinus] 2 j\_2\[RightDoubleBracket]\)\(.\)\)\)]] }], "Text"], Cell[BoxData[ \(coefS[i1_, j1_, i2_, j2_] := Which[\[IndentingNewLine]i2 \[Equal] 0 && j2 \[Equal] 0, ss[i1, j1], \[IndentingNewLine]i2 \[Equal] 0, ss[i1, j1 - 2 j2] + ss[i1, j1 + 2 j2], \[IndentingNewLine]j2 \[Equal] 0, ss[i1 - 2 i2, j1] + ss[i1 + 2 i2, j1], \[IndentingNewLine]True, ss[i1 - 2 i2, j1 - 2 j2] + ss[i1 - 2 i2, j1 + 2 j2] + ss[i1 + 2 i2, j1 - 2 j2] + ss[i1 + 2 i2, j1 + 2 j2]]\)], "Input",\ InitializationCell->True, CellTags->"EQN exact harmonic comp"], Cell[CellGroupData[{ Cell[BoxData[ \(Round[10000*Table[coefS[i, j, 0, 0], {i, 0, 4}, {j, 0, 4}]]*0.0001 // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1.4535`", "0.4535`", \(-0.1277`\), \(-0.033800000000000004`\), \(-0.0106`\ \)}, {"0.4535`", "0.2441`", "0.0347`", "0.0015`", \(-0.0022`\)}, {\(-0.1277`\), "0.0347`", "0.021`", "0.0073`", "0.0019`"}, {\(-0.033800000000000004`\), "0.0015`", "0.0073`", "0.0048000000000000004`", "0.0023`"}, {\(-0.0106`\), \(-0.0022`\), "0.0019`", "0.0023`", "0.0016`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Round[10000*Table[coefS[i, j, 1, 0], {i, 0, 4}, {j, 0, 4}]]*0.0001 // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(-0.2554`\), "0.0695`", "0.042100000000000005`", "0.0146`", "0.0038`"}, {"0.4197`", "0.2456`", "0.042100000000000005`", "0.0063`", "0.0001`"}, {"1.443`", "0.45130000000000003`", \(-0.1258`\), \(-0.0315`\), \ \(-0.0089`\)}, {"0.4496`", "0.2424`", "0.035`", "0.0025`", \(-0.0013000000000000002`\)}, {\(-0.1295`\), "0.033600000000000005`", "0.020800000000000003`", "0.0077`", "0.0024000000000000002`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Round[10000*Table[coefS[i, j, 1, 1], {i, 0, 4}, {j, 0, 4}]]*0.0001 // MatrixForm\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0.08410000000000001`", "0.08410000000000001`", \(-0.2516`\), "0.0699`", "0.0417`"}, {"0.08410000000000001`", "0.252`", "0.4198`", "0.24480000000000002`", "0.0413`"}, {\(-0.2516`\), "0.4198`", "1.4341000000000002`", "0.44830000000000003`", \(-0.12710000000000002`\)}, {"0.0699`", "0.24480000000000002`", "0.44830000000000003`", "0.24130000000000001`", "0.034300000000000004`"}, {"0.0417`", "0.0413`", \(-0.12710000000000002`\), "0.034300000000000004`", "0.021`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Subdivision for harmonic splines on a bounded rectangular domain\ \>", "Subsection"], Cell[CellGroupData[{ Cell["\<\ Construction of invertible inner product matrix for bounded harmonic \ splines\ \>", "Subsubsection"], Cell[TextData[{ "The function ", Cell[BoxData[ \(addMoment\)]], " takes the inner product matrix ", Cell[BoxData[ \(E\)]], " and replaces one of the rows with the moment vector ", Cell[BoxData[ RowBox[{"(", GridBox[{ {"1", "2", "2", "."}, {"2", "4", "4", "."}, {"2", "4", "4", "."}, {".", ".", ".", "."} }], ")"}]]], "." }], "Text"], Cell[BoxData[ \(addMoment[l_] := Module[{n = Length[l], temp = l}, \[IndentingNewLine]temp\[LeftDoubleBracket]1, 1\[RightDoubleBracket] = \(1\/\(4 \((n - 1)\)\^2\)\) Table[If[i \[Equal] 1 || i \[Equal] n, 1, 2] If[j \[Equal] 1 || j \[Equal] n, 1, 2], {i, n}, {j, n}]; \[IndentingNewLine]temp]\)], "Input", InitializationCell->True], Cell[TextData[{ "The function ", Cell[BoxData[ \(upsample2D\)]], " performs upsampling on a 2D grid" }], "Text"], Cell[BoxData[ \(upsample2D[ l_] := \[IndentingNewLine]Table[\[IndentingNewLine]If[ OddQ[i] && OddQ[j], l\[LeftDoubleBracket]\(i + 1\)\/2, \(j + \ 1\)\/2\[RightDoubleBracket], 0*l\[LeftDoubleBracket]1, 1\[RightDoubleBracket]], \[IndentingNewLine]{i, 2 \( Dimensions[l]\)\[LeftDoubleBracket]1\[RightDoubleBracket] - 1}, {j, 2 \( Dimensions[ l]\)\[LeftDoubleBracket]2\[RightDoubleBracket] - 1}]\)], "Input", InitializationCell->True], Cell[BoxData[ \(matSS[n_] := \(matSS[n] = LinearSolve[\[IndentingNewLine]flatten4D[addMoment[matEE[2 n]]] // N, \[IndentingNewLine]flatten4D[ upsample2D[addMoment[matEE[n]]] // N]]\)\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"GraphicsArray", "[", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"(", GridBox[{ {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"} }], ")"}], ",", \(PlotRange \[Rule] All\), ",", \(Ticks \[Rule] {False, False, True}\)}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"unflatten", "[", RowBox[{\(matSS[7]\), ".", RowBox[{"Flatten", "[", RowBox[{"(", GridBox[{ {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"} }], ")"}], "]"}]}], "]"}], ",", \(PlotRange \[Rule] All\), ",", \(Ticks \[Rule] {False, False, True}\)}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"unflatten", "[", RowBox[{\(matSS[14]\), ".", \(matSS[7]\), ".", RowBox[{"Flatten", "[", RowBox[{"(", GridBox[{ {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"} }], ")"}], "]"}]}], "]"}], ",", \(PlotRange \[Rule] All\), ",", \(Ticks \[Rule] {False, False, True}\)}], "]"}]}], "}"}], "]"}], "]"}]], "Input", CellTags->"FIG exact bounded harmonic example"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] GraphicsArray \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]], Cell[TextData[{ "Central column of subdivision matrix for domain ", Cell[BoxData[ \(\([0, 8]\)\^2\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Round[ 10000*With[{SS = unflatten[ Map[unflatten, matSS[8]]]}, \[IndentingNewLine]Table[ SS\[LeftDoubleBracket]i, j, 5, 5\[RightDoubleBracket], {i, 5, 13}, {j, 5, 13}]]]*0.0001 // MatrixForm\)], "Input", CellTags->"FIG approximation to exact mask"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0.0016`", "0.0023`", "0.0018000000000000002`", \(-0.0023`\), \ \(-0.010700000000000001`\), \(-0.0023`\), "0.0018000000000000002`", "0.0023`", "0.0016`"}, {"0.0023`", "0.0048000000000000004`", "0.007200000000000001`", "0.0014`", \(-0.0339`\), "0.0014`", "0.007200000000000001`", "0.0048000000000000004`", "0.0023`"}, {"0.0018000000000000002`", "0.007200000000000001`", "0.020900000000000002`", "0.0346`", \(-0.1278`\), "0.0346`", "0.020900000000000002`", "0.007200000000000001`", "0.0018000000000000002`"}, {\(-0.0023`\), "0.0014`", "0.0346`", "0.24400000000000002`", "0.4534`", "0.24400000000000002`", "0.0346`", "0.0014`", \(-0.0023`\)}, {\(-0.010700000000000001`\), \(-0.0339`\), \(-0.1278`\), "0.4534`", "1.4534`", "0.4534`", \(-0.1278`\), \(-0.0339`\), \(-0.010700000000000001`\ \)}, {\(-0.0023`\), "0.0014`", "0.0346`", "0.24400000000000002`", "0.4534`", "0.24400000000000002`", "0.0346`", "0.0014`", \(-0.0023`\)}, {"0.0018000000000000002`", "0.007200000000000001`", "0.020900000000000002`", "0.0346`", \(-0.1278`\), "0.0346`", "0.020900000000000002`", "0.007200000000000001`", "0.0018000000000000002`"}, {"0.0023`", "0.0048000000000000004`", "0.007200000000000001`", "0.0014`", \(-0.0339`\), "0.0014`", "0.007200000000000001`", "0.0048000000000000004`", "0.0023`"}, {"0.0016`", "0.0023`", "0.0018000000000000002`", \(-0.0023`\), \ \(-0.010700000000000001`\), \(-0.0023`\), "0.0018000000000000002`", "0.0023`", "0.0016`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell["Comparison with unbounded mask", "Text"], Cell[BoxData[GridBox[{ {"0.0016`", "0.0023`", "0.0019`", \(-0.0022`\), \(-0.0106`\), \(-0.0022`\), "0.0019`", "0.0023`", "0.0016`"}, {"0.0023`", "0.0048000000000000004`", "0.0073`", "0.0015`", \(-0.033800000000000004`\), "0.0015`", "0.0073`", "0.0048000000000000004`", "0.0023`"}, {"0.0019`", "0.0073`", "0.021`", "0.0347`", \(-0.1277`\), "0.0347`", "0.021`", "0.0073`", "0.0019`"}, {\(-0.0022`\), "0.0015`", "0.0347`", "0.2441`", "0.4535`", "0.2441`", "0.0347`", "0.0015`", \(-0.0022`\)}, {\(-0.0106`\), \(-0.033800000000000004`\), \(-0.1277`\), "0.4535`", "1.4535`", "0.4535`", \(-0.1277`\), \(-0.033800000000000004`\), \(-0.0106`\)}, {\(-0.0022`\), "0.0015`", "0.0347`", "0.2441`", "0.4535`", "0.2441`", "0.0347`", "0.0015`", \(-0.0022`\)}, {"0.0019`", "0.0073`", "0.021`", "0.0347`", \(-0.1277`\), "0.0347`", "0.021`", "0.0073`", "0.0019`"}, {"0.0023`", "0.0048000000000000004`", "0.0073`", "0.0015`", \(-0.033800000000000004`\), "0.0015`", "0.0073`", "0.0048000000000000004`", "0.0023`"}, {"0.0016`", "0.0023`", "0.0019`", \(-0.0022`\), \(-0.0106`\), \(-0.0022`\), "0.0019`", "0.0023`", "0.0016`"} }]], "NumberedFigure", CellFrameLabels->{{None, Inherited}, {Inherited, Inherited}}, GridBoxOptions->{ColumnAlignments->{Center}}], Cell[TextData[{ "Corner masks for domains ", Cell[BoxData[ \(\([0, 4]\)\^2\)]], " and ", Cell[BoxData[ \(\([0, 8]\)\^2\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(Round[ 10000*unflatten[\(matSS[ 4]\)\[LeftDoubleBracket]1\[RightDoubleBracket]]]*0.0001 // MatrixForm\), "\[IndentingNewLine]", \(Round[ 10000*unflatten[\(matSS[ 8]\)\[LeftDoubleBracket]1\[RightDoubleBracket]]]*0.0001 // MatrixForm\)}], "Input", CellTags->"FIG approximating a corner rule for harmonic splines"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { "1.4534`", \(-0.2556`\), \(-0.0213`\), \ \(-0.0039000000000000003`\), \(-0.001`\)}, {\(-0.2556`\), "0.0838`", "0.0073`", \(-0.0012000000000000001`\), \(-0.0008`\)}, {\(-0.0213`\), "0.0073`", "0.006500000000000001`", "0.0021000000000000003`", "0.0005`"}, {\(-0.0039000000000000003`\), \(-0.0012000000000000001`\), "0.0021000000000000003`", "0.002`", "0.0009000000000000001`"}, {\(-0.001`\), \(-0.0008`\), "0.0005`", "0.0009000000000000001`", "0.0004`"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { "1.4535`", \(-0.2554`\), \(-0.0211`\), \(-0.0035`\), \ \(-0.001`\), \(-0.0004`\), \(-0.0002`\), \(-0.0001`\), \(-0.0001`\)}, {\(-0.2554`\), "0.08410000000000001`", "0.0076`", \(-0.0008`\), \(-0.0009000000000000001`\), \ \(-0.0005`\), \(-0.00030000000000000003`\), \(-0.0002`\), \(-0.0001`\)}, {\(-0.0211`\), "0.0076`", "0.0066`", "0.0019`", "0.0004`", "0", \(-0.0001`\), \(-0.0001`\), \(-0.0001`\)}, {\(-0.0035`\), \(-0.0008`\), "0.0019`", "0.0014`", "0.0006000000000000001`", "0.0002`", "0.0001`", "0", "0"}, {\(-0.001`\), \(-0.0009000000000000001`\), "0.0004`", "0.0006000000000000001`", "0.0004`", "0.00030000000000000003`", "0.0001`", "0.0001`", "0"}, {\(-0.0004`\), \(-0.0005`\), "0", "0.0002`", "0.00030000000000000003`", "0.0002`", "0.0001`", "0.0001`", "0"}, {\(-0.0002`\), \(-0.00030000000000000003`\), \(-0.0001`\), "0.0001`", "0.0001`", "0.0001`", "0.0001`", "0.0001`", "0.0001`"}, {\(-0.0001`\), \(-0.0002`\), \(-0.0001`\), "0", "0.0001`", "0.0001`", "0.0001`", "0.0001`", "0.0001`"}, {\(-0.0001`\), \(-0.0001`\), \(-0.0001`\), "0", "0", "0", "0.0001`", "0.0001`", "0"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Using corner, edge and interior masks from smalls grids to approximate masks \ for large grids\ \>", "Subsubsection"], Cell[TextData[{ "Given an index for a large grid, the functions ", Cell[BoxData[ \(indx1\)]], " (row) and ", Cell[BoxData[ \(indx2\)]], " (column) are used to select an appropriate index from a small grids. The \ function ", Cell[BoxData[ \(paddedS\)]], " uses these functions to builds the subdivision matrix for the large grid \ using a padded version of the subdivision matrix for the small grid." }], "Text"], Cell[BoxData[ \(indx1[i_, n_] := \[IndentingNewLine]Which[\[IndentingNewLine]0 \[LessEqual] i \[LessEqual] 4, i, \[IndentingNewLine]2 n - 4 \[LessEqual] i \[LessEqual] 2 n, i - \((2 n - 4)\) + 4, \[IndentingNewLine]i \[LessEqual] n && OddQ[i], 3, \[IndentingNewLine]i \[LessEqual] n && EvenQ[i], 4, \[IndentingNewLine]i > n && OddQ[i], 5, \[IndentingNewLine]i > n && EvenQ[i], 4]\)], "Input"], Cell[BoxData[ \(indx2[i_, n_] := \[IndentingNewLine]Which[\[IndentingNewLine]0 \[LessEqual] i \[LessEqual] 4, Range[0, 4], \[IndentingNewLine]2 n - 4 \[LessEqual] i \[LessEqual] 2 n, Range[n - 4, n], \[IndentingNewLine]i \[LessEqual] n && OddQ[i], Range[\(i + 1\)\/2 - 2, \(i + 1\)\/2 + 2], \[IndentingNewLine]i \[LessEqual] n && EvenQ[i], Range[i\/2 - 2, i\/2 + 2], \[IndentingNewLine]i > n && OddQ[i], Range[\(i - 1\)\/2 - 2, \(i - 1\)\/2 + 2], \[IndentingNewLine]i > n && EvenQ[i], Range[i\/2 - 2, i\/2 + 2]]\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[{ \(Table[indx1[i, 8], {i, 0, 16}]\), "\[IndentingNewLine]", \(MatrixForm[Table[indx2[i, 8], {i, 0, 16}]]\)}], "Input"], Cell[BoxData[ \({0, 1, 2, 3, 4, 3, 4, 3, 4, 5, 4, 5, 4, 5, 6, 7, 8}\)], "Output"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", "1", "2", "3", "4"}, {"0", "1", "2", "3", "4"}, {"0", "1", "2", "3", "4"}, {"0", "1", "2", "3", "4"}, {"0", "1", "2", "3", "4"}, {"1", "2", "3", "4", "5"}, {"1", "2", "3", "4", "5"}, {"2", "3", "4", "5", "6"}, {"2", "3", "4", "5", "6"}, {"2", "3", "4", "5", "6"}, {"3", "4", "5", "6", "7"}, {"3", "4", "5", "6", "7"}, {"4", "5", "6", "7", "8"}, {"4", "5", "6", "7", "8"}, {"4", "5", "6", "7", "8"}, {"4", "5", "6", "7", "8"}, {"4", "5", "6", "7", "8"} }], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[TextData[{ "The function ", Cell[BoxData[ \(paddedS\)]], " take a grid of control points ", Cell[BoxData[ \(p\)]], " and uses a padded version of the subdivision rules from ", Cell[BoxData[ \(matSS[4]\)]], " to subdivide ", Cell[BoxData[ \(p\)]], "." }], "Text"], Cell[BoxData[ \(paddedS[p_] := Module[{n = Length[p] - 1, mat = unflatten[ Map[unflatten, matSS[4]]]}, \ \[IndentingNewLine]Table[\[IndentingNewLine]Apply[Plus, Flatten[mat\[LeftDoubleBracket]indx1[i, n] + 1, indx1[j, n] + 1\[RightDoubleBracket]*\[IndentingNewLine]p\ \[LeftDoubleBracket]indx2[i, n] + 1, indx2[j, n] + 1\[RightDoubleBracket]]], \[IndentingNewLine]{i, 0, 2 n}, {j, 0, 2 n}]]\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"ListPlot3D", "[", RowBox[{ RowBox[{"Nest", "[", RowBox[{"paddedS", ",", RowBox[{"(", GridBox[{ {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "1", "1", "1", "1", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", "0"} }], ")"}], ",", "3"}], "]"}], ",", \(PlotRange \[Rule] All\), ",", \(Ticks \[Rule] {False, False, True}\)}], "]"}]], "Input", CellTags->"FIG approx bounded harmonic example"], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] SurfaceGraphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Open ]] }, Closed]] }, Open ]] }, Open ]] }, Open ]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1280}, {0, 951}}, AutoGeneratedPackage->None, ScreenStyleEnvironment->"Working", WindowSize->{1016, 668}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, PrintingOptions->{"PrintingMargins"->{{36, 36}, {54, 54}}}, Magnification->1.25, StyleDefinitions -> Notebook[{ Cell[CellGroupData[{ Cell["Style Definitions", "Subtitle"], Cell["\<\ Modify the definitions below to change the default appearance of all cells in \ a given style. Make modifications to any definition using commands in the \ Format menu.\ \>", "Text"], Cell[CellGroupData[{ Cell["Style Environment Names", "Section"], Cell[StyleData[All, "Working"], PageWidth->WindowWidth, ScriptMinSize->9], Cell[StyleData[All, "Presentation"], PageWidth->WindowWidth, ScriptMinSize->12, FontSize->16], Cell[StyleData[All, "Condensed"], PageWidth->WindowWidth, CellBracketOptions->{"Margins"->{1, 1}, "Widths"->{0, 5}}, ScriptMinSize->8, FontSize->11], Cell[StyleData[All, "Printout"], PageWidth->PaperWidth, ScriptMinSize->7, FontSize->10, PrivateFontOptions->{"FontType"->"Outline"}] }, Open ]], Cell[CellGroupData[{ Cell["Notebook Options", "Section"], Cell["\<\ The options defined for the style below will be used at the Notebook level.\ \>", "Text"], Cell[StyleData["Notebook"], PageHeaders->{{Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"], Cell[ TextData[ { ValueBox[ "DateLong"]}], "Header"], Cell[ TextData[ {"Chapter ", CounterBox[ "Chapter"]}], "Header"]}, {Cell[ TextData[ {"Chapter ", CounterBox[ "Chapter"]}], "Header"], Cell[ TextData[ { ValueBox[ "DateLong"]}], "Header"], Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}}, PageHeaderLines->{True, True}, PrintingOptions->{"PrintingMargins"->{{108, 72}, {72, 72}}, "FirstPageHeader"->False, "FacingPages"->True}, CellFrameLabelMargins->6, TextJustification->1, LineSpacing->{2, 0}, StyleMenuListing->None, FontSize->12] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Headings", "Section"], Cell[CellGroupData[{ Cell[StyleData["Title"], ShowCellBracket->False, CellMargins->{{0, 0}, {0, 0}}, PageBreakBelow->False, TextAlignment->Center, CounterIncrements->"Title", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Subtitle", 0}, {"Chapter", 0}}, FontSize->34, FontColor->GrayLevel[1], Background->RGBColor[0.571389, 0.19675, 0.570504]], Cell[StyleData["Title", "Presentation"], CellMargins->{{0, 0}, {0, 0}}, FontSize->44], Cell[StyleData["Title", "Condensed"], CellMargins->{{0, 0}, {0, 0}}, FontSize->20], Cell[StyleData["Title", "Printout"], CellMargins->{{0, 0}, {0, 0}}, FontSize->24, FontTracking->"Plain", Background->GrayLevel[0]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Subtitle"], ShowCellBracket->False, CellMargins->{{0, 0}, {0, 0}}, PageBreakBelow->False, TextAlignment->Center, ParagraphIndent->-96, CounterIncrements->"Subtitle", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Chapter", 0}}, FontFamily->"Helvetica", FontSize->18, FontColor->GrayLevel[1], Background->RGBColor[0.2, 0.700008, 0.700008]], Cell[StyleData["Subtitle", "Presentation"], CellMargins->{{0, 0}, {0, 0}}, ParagraphIndent->-157, FontSize->30], Cell[StyleData["Subtitle", "Condensed"], CellMargins->{{0, 0}, {0, 0}}, ParagraphIndent->-78, FontSize->14], Cell[StyleData["Subtitle", "Printout"], CellMargins->{{0, 0}, {0, 0}}, ParagraphIndent->-85, FontSize->16, Background->GrayLevel[0.6]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Chapter"], CellFrame->False, ShowCellBracket->True, ShowGroupOpenCloseIcon->False, ShowShortBoxForm->False, CellMargins->{{10, 4}, {50, 150}}, CellGroupingRules->{"SectionGrouping", 20}, PageBreakBelow->False, CellFrameLabels->{{Cell[ TextData[ {"Chapter ", CounterBox[ "Chapter"], ": "}]], None}, {None, None}}, CounterIncrements->"Chapter", CounterAssignments->{{"Section", 0}, {"NumberedEquation", 0}, { "NumberedFigure", 0}, {"NumberedTable", 0}, {"Theorem", 0}}, FontFamily->"Helvetica", FontSize->24, FontSlant->"Italic", Background->GrayLevel[1]], Cell[StyleData["Chapter", "Presentation"], CellMargins->{{8, 10}, {40, 20}}, FontSize->24], Cell[StyleData["Chapter", "Condensed"], CellMargins->{{8, 10}, {12, 8}}, FontSize->12], Cell[StyleData["Chapter", "Printout"], CellMargins->{{9, 10}, {50, 10}}, FontSize->14] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Section"], CellFrame->False, CellDingbat->None, CellMargins->{{12, Inherited}, {4, 24}}, CellGroupingRules->{"SectionGrouping", 30}, PageBreakBelow->False, CellFrameMargins->6, CellFrameLabels->{{Cell[ TextData[ { CounterBox[ "Chapter"], ".", CounterBox[ "Section"], " "}]], None}, {None, None}}, CounterIncrements->"Section", CounterAssignments->{{"Subsection", 0}, {"Subsubsection", 0}}, FontFamily->"Helvetica", FontSize->18, FontWeight->"Bold", FontColor->GrayLevel[0]], Cell[StyleData["Section", "Presentation"], CellMargins->{{10, 10}, {8, 32}}, FontSize->24, FontTracking->"Condensed"], Cell[StyleData["Section", "Condensed"], CellMargins->{{8, Inherited}, {2, 12}}, FontSize->12], Cell[StyleData["Section", "Printout"], CellMargins->{{9, 0}, {2, 50}}, FontSize->14, FontTracking->"Plain", FontColor->GrayLevel[0]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Subsection"], CellMargins->{{12, Inherited}, {8, 20}}, CellGroupingRules->{"SectionGrouping", 40}, PageBreakBelow->False, CellFrameLabels->{{Cell[ TextData[ { CounterBox[ "Chapter"], ".", CounterBox[ "Section"], ".", CounterBox[ "Subsection"], " "}]], None}, {None, None}}, CounterIncrements->"Subsection", CounterAssignments->{{"Subsubsection", 0}}, FontFamily->"Helvetica", FontSize->13, FontWeight->"Bold"], Cell[StyleData["Subsection", "Presentation"], CellMargins->{{11, 10}, {8, 32}}, FontSize->22], Cell[StyleData["Subsection", "Condensed"], CellMargins->{{8, Inherited}, {2, 12}}, FontSize->12], Cell[StyleData["Subsection", "Printout"], CellMargins->{{9, 0}, {4, 40}}, FontSize->12] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Subsubsection"], CellDingbat->"\[FilledSquare]", CellMargins->{{25, Inherited}, {8, 12}}, CellGroupingRules->{"SectionGrouping", 50}, PageBreakBelow->False, CounterIncrements->"Subsubsection", FontFamily->"Times", FontSize->12, FontWeight->"Bold"], Cell[StyleData["Subsubsection", "Presentation"], CellMargins->{{29, 10}, {8, 26}}, FontSize->18], Cell[StyleData["Subsubsection", "Condensed"], CellMargins->{{22, Inherited}, {2, 12}}, FontSize->10], Cell[StyleData["Subsubsection", "Printout"], CellMargins->{{21, 0}, {4, 20}}, FontSize->11] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Body Text", "Section"], Cell[CellGroupData[{ Cell[StyleData["Text"], CellMargins->{{12, 10}, {5, 5}}, PageBreakWithin->True, TextJustification->1, Hyphenation->True, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}, CounterIncrements->"Text", FontFamily->"Times"], Cell[StyleData["Text", "Presentation"], CellMargins->{{13, 10}, {8, 8}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}], Cell[StyleData["Text", "Condensed"], CellMargins->{{8, 10}, {4, 4}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 4}], Cell[StyleData["Text", "Printout"], CellMargins->{{9, 0}, {4, 4}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Itemize"], CellDingbat->"\[FilledSmallCircle]", CellMargins->{{36, 10}, {5, 5}}, TextJustification->1, Hyphenation->True, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}, CounterIncrements->"Text", FontFamily->"Times"], Cell[StyleData["Itemize", "Presentation"], CellDingbat->"\[FilledSmallCircle]", CellMargins->{{36, 10}, {8, 8}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}], Cell[StyleData["Itemize", "Condensed"], CellDingbat->"\[FilledSmallCircle]", CellMargins->{{36, 10}, {4, 4}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 4}], Cell[StyleData["Itemize", "Printout"], CellDingbat->"\[FilledSmallCircle]", CellMargins->{{36, 0}, {4, 4}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["ItemizeFollow"], CellMargins->{{36, 10}, {0, 0}}, TextJustification->1, Hyphenation->True, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}, CounterIncrements->"Text", FontFamily->"Times"], Cell[StyleData["ItemizeFollow", "Presentation"], CellMargins->{{36, 10}, {0, 0}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 12}], Cell[StyleData["ItemizeFollow", "Condensed"], CellMargins->{{36, 10}, {0, 0}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 4}], Cell[StyleData["ItemizeFollow", "Printout"], CellMargins->{{36, 0}, {0, 0}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["SmallText"], CellMargins->{{12, 10}, {5, 5}}, TextJustification->1, Hyphenation->True, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, ParagraphSpacing->{0, 6}, CounterIncrements->"SmallText", FontFamily->"Helvetica", FontSize->9], Cell[StyleData["SmallText", "Presentation"], CellMargins->{{13, 10}, {8, 8}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, FontSize->12], Cell[StyleData["SmallText", "Condensed"], CellMargins->{{8, 10}, {2, 2}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, FontSize->9], Cell[StyleData["SmallText", "Printout"], CellMargins->{{9, 0}, {4, 4}}, TextJustification->1, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, FontSize->7] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Input/Output", "Section"], Cell["\<\ The cells in this section define styles used for input and output to the \ kernel. Be careful when modifying, renaming, or removing these styles, \ because the front end associates special meanings with these style names.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Input"], CellMargins->{{52, 10}, {8, 8}}, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, CellLabelMargins->{{5, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultInputFormatType, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, CounterIncrements->"Input", FontWeight->"Bold", FontColor->GrayLevel[0], Background->RGBColor[0.500008, 1, 0.500008]], Cell[StyleData["Input", "Presentation"], CellMargins->{{62, Inherited}, {10, 10}}], Cell[StyleData["Input", "Condensed"], CellMargins->{{40, 10}, {4, 4}}], Cell[StyleData["Input", "Printout"], CellFrame->True, CellMargins->{{44, 0}, {6, 6}}, Background->None] }, Open ]], Cell[StyleData["InlineInput"], CellFrame->True, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, DefaultFormatType->DefaultInputFormatType, AutoItalicWords->{}, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, CounterIncrements->"Input", FontWeight->"Bold", Background->GrayLevel[0.849989]], Cell[CellGroupData[{ Cell[StyleData["Output"], CellMargins->{{52, 10}, {8, 8}}, CellEditDuplicate->True, CellGroupingRules->"OutputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, CellLabelMargins->{{3, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, FormatType->InputForm, CounterIncrements->"Output", Background->RGBColor[1, 1, 0.300008]], Cell[StyleData["Output", "Presentation"], CellMargins->{{62, Inherited}, {12, 5}}], Cell[StyleData["Output", "Condensed"], CellMargins->{{40, Inherited}, {4, 1}}], Cell[StyleData["Output", "Printout"], CellFrame->True, CellMargins->{{44, 0}, {6, 2}}, Background->None] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Unique Styles", "Section"], Cell[CellGroupData[{ Cell[StyleData["Author"], ShowCellBracket->False, CellMargins->{{10, 4}, {2, 10}}, TextAlignment->Center, FontSize->16, FontSlant->"Italic"], Cell[StyleData["Author", "Presentation"], CellMargins->{{12, 10}, {2, 12}}, ParagraphSpacing->{0, 12}, FontSize->20], Cell[StyleData["Author", "Condensed"], CellMargins->{{8, 10}, {1, 4}}, ParagraphSpacing->{0, 4}, FontSize->12], Cell[StyleData["Author", "Printout"], CellMargins->{{9, 0}, {4, 12}}, ParagraphSpacing->{0, 6}, FontSize->14] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Copyright"], ShowCellBracket->False, CellMargins->{{10, 10}, {40, 2}}, FontFamily->"Helvetica", FontSize->9], Cell[StyleData["Copyright", "Presentation"], CellMargins->{{12, 10}, {50, 2}}, FontSize->12], Cell[StyleData["Copyright", "Condensed"], CellMargins->{{8, 10}, {12, 1}}, FontSize->9], Cell[StyleData["Copyright", "Printout"], CellMargins->{{9, 0}, {72, 4}}, FontSize->7] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Equations, Figures, Theorems etc.", "Section"], Cell["\<\ The following styles are useful for numbered equations, figures, etc. They \ automatically give the cell a FrameLabel containing a reference to a \ particular counter, and also increment that counter.\ \>", "Text"], Cell[StyleData["Reference"], CellFrame->False, PageBreakWithin->False, GroupPageBreakWithin->False, CellFrameLabels->{{Cell[ TextData[ {"[", CounterBox[ "Reference"], "] "}]], None}, {None, None}}, ShowStringCharacters->True, CounterIncrements->"Reference"], Cell[CellGroupData[{ Cell[StyleData["Example"], CellMargins->{{12, 10}, {5, 12}}, PageBreakBelow->False, ParagraphSpacing->{0, 12}, CounterIncrements->"Example", FontFamily->"Times", FontWeight->"Bold"], Cell[StyleData["Example", "Presentation"], CellMargins->{{18, 10}, {8, 20}}, ParagraphSpacing->{0, 12}], Cell[StyleData["Example", "Condensed"], CellMargins->{{8, 10}, {4, 8}}, ParagraphSpacing->{0, 4}], Cell[StyleData["Example", "Printout"], CellMargins->{{9, 0}, {4, 10}}, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["ExampleCode"], CellMargins->{{24, 10}, {0, 10}}, PageBreakBelow->False, DefaultNewCellStyle->"ExampleCodeExplanation", ParagraphSpacing->{0, 12}, CounterIncrements->"Example", FontFamily->"Times", FontWeight->"Plain", FontColor->RGBColor[0, 0, 0.996109]], Cell[StyleData["ExampleCode", "Presentation"], CellMargins->{{18, 10}, {8, 10}}, ParagraphSpacing->{0, 12}], Cell[StyleData["ExampleCode", "Condensed"], CellMargins->{{8, 10}, {4, 10}}, ParagraphSpacing->{0, 4}], Cell[StyleData["ExampleCode", "Printout"], CellMargins->{{9, 0}, {0, 10}}, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["ExampleCodeExplanation"], CellMargins->{{24, 10}, {10, 0}}, PageBreakAbove->False, DefaultNewCellStyle->"ExampleCode", ParagraphSpacing->{0, 12}, CounterIncrements->"Example", FontFamily->"Times", FontWeight->"Plain", FontColor->GrayLevel[0.749996]], Cell[StyleData["ExampleCodeExplanation", "Presentation"], CellMargins->{{18, 10}, {8, 20}}, PageBreakAbove->False, ParagraphSpacing->{0, 12}], Cell[StyleData["ExampleCodeExplanation", "Condensed"], CellMargins->{{8, 10}, {4, 8}}, PageBreakAbove->False, ParagraphSpacing->{0, 4}], Cell[StyleData["ExampleCodeExplanation", "Printout"], CellMargins->{{9, 0}, {4, 0}}, PageBreakAbove->False, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Proof"], CellFrame->False, CellMargins->{{52, 10}, {0, 0}}, PageBreakWithin->False, PageBreakBelow->False, GroupPageBreakWithin->False, CellLabelMargins->{{23, Inherited}, {Inherited, Inherited}}, CellFrameLabels->{{Cell[ TextData[ {"Proof "}]], None}, {None, None}}, ShowStringCharacters->True, CounterIncrements->"Proof", FontFamily->"Helvetica", FontWeight->"Bold", FontColor->RGBColor[0.2, 0.700008, 0.700008], Background->None], Cell[StyleData["Proof", "Presentation"], CellMargins->{{62, Inherited}, {0, 0}}, PageBreakBelow->False], Cell[StyleData["Proof", "Condensed"], CellMargins->{{40, 10}, {0, 0}}, PageBreakBelow->False], Cell[StyleData["Proof", "Printout"], CellMargins->{{44, 0}, {0, 0}}, PageBreakBelow->False] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Theorem"], CellFrame->False, CellMargins->{{52, 10}, {0, 0}}, PageBreakWithin->False, PageBreakBelow->False, GroupPageBreakWithin->False, CellLabelMargins->{{23, Inherited}, {Inherited, Inherited}}, CellFrameLabels->{{Cell[ TextData[ {"Theorem ", CounterBox[ "Chapter"], ".", CounterBox[ "Theorem"], " "}]], None}, {None, None}}, ShowStringCharacters->True, CounterIncrements->"Theorem", FontFamily->"Helvetica", FontWeight->"Bold", FontColor->RGBColor[0.571389, 0.19675, 0.570504], Background->None], Cell[StyleData["Theorem", "Presentation"], CellMargins->{{62, Inherited}, {0, 0}}, PageBreakBelow->False], Cell[StyleData["Theorem", "Condensed"], CellMargins->{{40, 10}, {0, 0}}, PageBreakBelow->False], Cell[StyleData["Theorem", "Printout"], CellMargins->{{44, 0}, {0, 0}}, PageBreakBelow->False] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Exercise"], CellDingbat->"\[FilledDownTriangle]", CellMargins->{{23, Inherited}, {4, 18}}, CellGroupingRules->{"SectionGrouping", 50}, PageBreakBelow->False, CounterIncrements->"Subsubsection", FontFamily->"Times", FontSize->13, FontWeight->"Bold", FontColor->RGBColor[0.571389, 0.19675, 0.570504], Background->None], Cell[StyleData["Exercise", "Presentation"], CellMargins->{{33, 10}, {8, 26}}, FontSize->18], Cell[StyleData["Exercise", "Condensed"], CellMargins->{{17, Inherited}, {2, 12}}, FontSize->10], Cell[StyleData["Exercise", "Printout"], CellFrame->{{0, 0}, {0.5, 0}}, CellDingbat->None, CellMargins->{{9, 0}, {6, 20}}, FontSize->11, FontColor->GrayLevel[0]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["TheoremProofText"], CellMargins->{{52, 10}, {5, 5}}, TextJustification->1, ParagraphSpacing->{0, 12}, CounterIncrements->"Text", FontFamily->"Times"], Cell[StyleData["TheoremProofText", "Presentation"], CellMargins->{{52, 10}, {8, 8}}, TextJustification->1, ParagraphSpacing->{0, 12}], Cell[StyleData["TheoremProofText", "Condensed"], CellMargins->{{8, 10}, {4, 4}}, TextJustification->1, ParagraphSpacing->{0, 4}], Cell[StyleData["TheoremProofText", "Printout"], CellMargins->{{52, 0}, {4, 4}}, TextJustification->1, ParagraphSpacing->{0, 6}] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["NumberedEquation"], CellMargins->{{62, 10}, {Inherited, Inherited}}, CellFrameLabels->{{None, Cell[ TextData[ {"(", CounterBox[ "Chapter"], ".", CounterBox[ "NumberedEquation"], ")"}]]}, {None, None}}, DefaultFormatType->DefaultInputFormatType, TextAlignment->Center, CounterIncrements->"NumberedEquation", FormatTypeAutoConvert->False], Cell[StyleData["NumberedEquation", "Presentation"], CellMargins->{{74, 10}, {Inherited, Inherited}}], Cell[StyleData["NumberedEquation", "Condensed"], CellMargins->{{52, 10}, {Inherited, Inherited}}], Cell[StyleData["NumberedEquation", "Printout"], CellMargins->{{54, 0}, {Inherited, Inherited}}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Equation"], CellMargins->{{62, 10}, {Inherited, Inherited}}, DefaultFormatType->DefaultInputFormatType, TextAlignment->Center, FormatTypeAutoConvert->False], Cell[StyleData["Equation", "Presentation"], CellMargins->{{74, 10}, {Inherited, Inherited}}], Cell[StyleData["Equation", "Condensed"], CellMargins->{{52, 10}, {Inherited, Inherited}}], Cell[StyleData["Equation", "Printout"], CellMargins->{{54, 0}, {Inherited, Inherited}}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["NumberedFigure"], CellMargins->{{0, 0}, {0, 24}}, CellFrameLabels->{{None, None}, {Cell[ TextData[ {"Figure ", CounterBox[ "Chapter"], ".", CounterBox[ "NumberedFigure"]}]], None}}, TextAlignment->Center, CounterIncrements->"NumberedFigure", FormatTypeAutoConvert->False], Cell[StyleData["NumberedFigure", "Presentation"]], Cell[StyleData["NumberedFigure", "Condensed"]], Cell[StyleData["NumberedFigure", "Printout"]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["Caption"], CellMargins->{{72, 72}, {24, 0}}, PageBreakAbove->False, PageBreakWithin->False, TextAlignment->Center, Hyphenation->True, HyphenationOptions->{"HyphenationCharacter"->"\[Hyphen]"}, FontSlant->"Italic"], Cell[StyleData["Caption", "Presentation"]], Cell[StyleData["Caption", "Condensed"]], Cell[StyleData["Caption", "Printout"]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Headers and Footers", "Section"], Cell[StyleData["Header"], CellMargins->{{0, 0}, {4, 1}}, StyleMenuListing->None, FontFamily->"Helvetica", FontSize->9, FontSlant->"Italic"], Cell[StyleData["Footer"], CellMargins->{{0, 0}, {0, 4}}, StyleMenuListing->None, FontFamily->"Helvetica", FontSize->6], Cell[StyleData["PageNumber"], CellMargins->{{0, 0}, {4, 1}}, StyleMenuListing->None, FontFamily->"Helvetica", FontSize->9, FontWeight->"Bold"] }, Open ]], Cell[CellGroupData[{ Cell["Hyperlink Styles", "Section"], Cell["\<\ The cells below define styles useful for making hypertext ButtonBoxes. The \ \"Hyperlink\" style is for links within the same Notebook, or between \ Notebooks.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Hyperlink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookLocate[ #2]}]&), Active->True, ButtonFrame->"None", ButtonNote->ButtonData}], Cell[StyleData["Hyperlink", "Presentation"]], Cell[StyleData["Hyperlink", "Condensed"]], Cell[StyleData["Hyperlink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]], Cell["\<\ The following styles are for linking automatically to the on-line help \ system.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["MainBookLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "MainBook", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["MainBookLink", "Presentation"]], Cell[StyleData["MainBookLink", "Condensed"]], Cell[StyleData["MainBookLink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["AddOnsLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "AddOns", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["AddOnsLink", "Presentation"]], Cell[StyleData["AddOnsLink", "Condensed"]], Cell[StyleData["AddOnLink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["RefGuideLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "RefGuideLink", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["RefGuideLink", "Presentation"]], Cell[StyleData["RefGuideLink", "Condensed"]], Cell[StyleData["RefGuideLink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["GettingStartedLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "GettingStarted", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["GettingStartedLink", "Presentation"]], Cell[StyleData["GettingStartedLink", "Condensed"]], Cell[StyleData["GettingStartedLink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["OtherInformationLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->GrayLevel[1], Background->RGBColor[1, 0.4, 0], ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "OtherInformation", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["OtherInformationLink", "Presentation"]], Cell[StyleData["OtherInformationLink", "Condensed"]], Cell[StyleData["OtherInformationLink", "Printout"], FontColor->GrayLevel[0], Background->GrayLevel[1]] }, Closed]] }, Open ]] }, Open ]] }] ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{ "CHA variational"->{ Cell[1739, 51, 129, 2, 341, "Chapter", CounterAssignments->{{"Chapter", 5}}, CellTags->"CHA variational"]}, "EQN compute interpolation mask"->{ Cell[5828, 172, 650, 14, 125, "Input", InitializationCell->True, CellTags->"EQN compute interpolation mask"]}, "exact inner prod"->{ Cell[8071, 256, 74, 1, 74, "Subsection", CellTags->"exact inner prod"]}, "fourPtArea"->{ Cell[13101, 451, 102, 2, 60, "Input", CellTags->"fourPtArea"]}, "FIG circle area"->{ Cell[14035, 486, 380, 9, 137, "Input", CellTags->"FIG circle area"]}, "SUBSEC math model"->{ Cell[14702, 512, 97, 1, 74, "Subsection", CellTags->"SUBSEC math model"]}, "EQN natcub energy"->{ Cell[14903, 519, 592, 16, 77, "Input", InitializationCell->True, CellTags->"EQN natcub energy"]}, "EQN natcub pde"->{ Cell[15915, 557, 449, 12, 61, "Input", CellTags->"EQN natcub pde"]}, "SUBSEC natural cubic inner product"->{ Cell[16676, 585, 121, 1, 53, "Subsection", CellTags->"SUBSEC natural cubic inner product"]}, "FIG finite element plot"->{ Cell[17064, 599, 1570, 26, 230, "Input", CellTags->"FIG finite element plot"]}, "SUBSEC compute S"->{ Cell[24650, 832, 97, 1, 74, "Subsection", CellTags->"SUBSEC compute S"]}, "EQN upsampling"->{ Cell[25821, 876, 291, 7, 74, "Input", InitializationCell->True, CellTags->"EQN upsampling"]}, "subd template"->{ Cell[28783, 979, 335, 7, 74, "Input", CellTags->"subd template"]}, "FIG differences are zero"->{ Cell[30711, 1038, 1873, 34, 333, "Input", CellTags->"FIG differences are zero"]}, "inv interp"->{ Cell[39337, 1279, 311, 10, 128, "Input", CellTags->"inv interp"]}, "direct energy"->{ Cell[41600, 1356, 1199, 27, 421, "Input", CellTags->"direct energy"]}, "FIG energy multi res"->{ Cell[45197, 1460, 1757, 34, 288, "Input", CellTags->"FIG energy multi res"]}, "SUBSEC bounded biharmonic inner product"->{ Cell[47239, 1510, 129, 1, 74, "Subsection", CellTags->"SUBSEC bounded biharmonic inner product"]}, "FIG finite element subdivision"->{ Cell[47679, 1525, 274, 5, 99, "Input", CellTags->"FIG finite element subdivision"]}, "FIG compute inner product matrix"->{ Cell[60798, 1862, 218, 4, 60, "Input", CellTags->"FIG compute inner product matrix"]}, "comp mask"->{ Cell[63512, 1932, 418, 10, 114, "Input", InitializationCell->True, CellTags->"comp mask"]}, "EQN exact harmonic comp"->{ Cell[65379, 1985, 554, 11, 144, "Input", InitializationCell->True, CellTags->"EQN exact harmonic comp"]}, "FIG exact bounded harmonic example"->{ Cell[70592, 2141, 3037, 55, 627, "Input", CellTags->"FIG exact bounded harmonic example"]}, "FIG approximation to exact mask"->{ Cell[73937, 2213, 354, 7, 81, "Input", CellTags->"FIG approximation to exact mask"]}, "FIG approximating a corner rule for harmonic splines"->{ Cell[78036, 2304, 409, 9, 81, "Input", CellTags->"FIG approximating a corner rule for harmonic splines"]}, "FIG approx bounded harmonic example"->{ Cell[84512, 2477, 852, 17, 182, "Input", CellTags->"FIG approx bounded harmonic example"]} } *) (*CellTagsIndex CellTagsIndex->{ {"CHA variational", 114458, 3525}, {"EQN compute interpolation mask", 114620, 3529}, {"exact inner prod", 114771, 3533}, {"fourPtArea", 114872, 3536}, {"FIG circle area", 114969, 3539}, {"SUBSEC math model", 115074, 3542}, {"EQN natcub energy", 115184, 3545}, {"EQN natcub pde", 115320, 3549}, {"SUBSEC natural cubic inner product", 115441, 3552}, {"FIG finite element plot", 115575, 3555}, {"SUBSEC compute S", 115689, 3558}, {"EQN upsampling", 115795, 3561}, {"subd template", 115926, 3565}, {"FIG differences are zero", 116035, 3568}, {"inv interp", 116145, 3571}, {"direct energy", 116243, 3574}, {"FIG energy multi res", 116352, 3577}, {"SUBSEC bounded biharmonic inner product", 116487, 3580}, {"FIG finite element subdivision", 116634, 3583}, {"FIG compute inner product matrix", 116769, 3586}, {"comp mask", 116883, 3589}, {"EQN exact harmonic comp", 117022, 3593}, {"FIG exact bounded harmonic example", 117186, 3597}, {"FIG approximation to exact mask", 117327, 3600}, {"FIG approximating a corner rule for harmonic splines", 117483, 3603}, {"FIG approx bounded harmonic example", 117643, 3606} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1739, 51, 129, 2, 341, "Chapter", CounterAssignments->{{"Chapter", 5}}, CellTags->"CHA variational"], Cell[1871, 55, 434, 12, 82, "Text"], Cell[2308, 69, 369, 6, 117, "Text"], Cell[2680, 77, 559, 10, 118, "Text"], Cell[CellGroupData[{ Cell[3264, 91, 64, 0, 60, "Subsubsection"], Cell[3331, 93, 278, 6, 81, "Input", InitializationCell->True], Cell[3612, 101, 418, 8, 104, "Input", InitializationCell->True], Cell[4033, 111, 691, 12, 102, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[4761, 128, 68, 0, 64, "Section"], Cell[CellGroupData[{ Cell[4854, 132, 39, 0, 74, "Subsection"], Cell[CellGroupData[{ Cell[4918, 136, 77, 0, 60, "Subsubsection"], Cell[4998, 138, 98, 4, 47, "Text"], Cell[5099, 144, 83, 2, 60, "Input", InitializationCell->True], Cell[5185, 148, 640, 22, 117, "Text"], Cell[5828, 172, 650, 14, 125, "Input", InitializationCell->True, CellTags->"EQN compute interpolation mask"], Cell[6481, 188, 226, 4, 112, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[6732, 196, 100, 2, 81, "Input"], Cell[6835, 200, 62, 1, 77, "Output"], Cell[6900, 203, 38, 1, 60, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[6987, 210, 75, 0, 49, "Subsubsection"], Cell[7065, 212, 177, 4, 80, "Input", InitializationCell->True], Cell[7245, 218, 63, 0, 47, "Text"], Cell[CellGroupData[{ Cell[7333, 222, 160, 3, 102, "Input"], Cell[7496, 227, 62, 1, 77, "Output"], Cell[7561, 230, 48, 1, 77, "Output"], Cell[7612, 233, 49, 1, 60, "Output"] }, Open ]], Cell[7676, 237, 66, 0, 47, "Text"], Cell[CellGroupData[{ Cell[7767, 241, 109, 2, 81, "Input"], Cell[7879, 245, 38, 1, 60, "Output"], Cell[7920, 248, 90, 1, 77, "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[8071, 256, 74, 1, 74, "Subsection", CellTags->"exact inner prod"], Cell[CellGroupData[{ Cell[8170, 261, 77, 0, 60, "Subsubsection"], Cell[8250, 263, 378, 17, 82, "Text"], Cell[8631, 282, 407, 9, 118, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[9063, 295, 61, 1, 60, "Input"], Cell[9127, 298, 147, 3, 77, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[9323, 307, 73, 0, 49, "Subsubsection"], Cell[9399, 309, 437, 21, 64, "Text"], Cell[9839, 332, 205, 4, 99, "Input", InitializationCell->True] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[10093, 342, 72, 0, 74, "Subsection"], Cell[CellGroupData[{ Cell[10190, 346, 78, 0, 60, "Subsubsection"], Cell[10271, 348, 202, 5, 47, "Text"], Cell[10476, 355, 468, 12, 47, "Equation"], Cell[10947, 369, 114, 5, 47, "Text"], Cell[11064, 376, 86, 1, 60, "Input"], Cell[11153, 379, 521, 11, 77, "Input"], Cell[CellGroupData[{ Cell[11699, 394, 60, 1, 60, "Input"], Cell[11762, 397, 45, 1, 60, "Output"] }, Open ]], Cell[11822, 401, 69, 0, 47, "Text"], Cell[CellGroupData[{ Cell[11916, 405, 73, 1, 60, "Input"], Cell[11992, 408, 136, 2, 77, "Output"] }, Open ]], Cell[12143, 413, 131, 3, 47, "Text"], Cell[CellGroupData[{ Cell[12299, 420, 240, 4, 102, "Input"], Cell[12542, 426, 35, 1, 60, "Output"] }, Open ]], Cell[12592, 430, 117, 3, 47, "Text"], Cell[CellGroupData[{ Cell[12734, 437, 210, 4, 137, "Input"], Cell[12947, 443, 52, 1, 60, "Output"] }, Open ]], Cell[13014, 447, 62, 0, 47, "Text"], Cell[CellGroupData[{ Cell[13101, 451, 102, 2, 60, "Input", CellTags->"fourPtArea"], Cell[13206, 455, 245, 4, 77, "Output"] }, Open ]], Cell[13466, 462, 122, 3, 47, "Text"], Cell[CellGroupData[{ Cell[13613, 469, 241, 4, 102, "Input"], Cell[13857, 475, 35, 1, 60, "Output"] }, Open ]], Cell[13907, 479, 103, 3, 47, "Text"], Cell[CellGroupData[{ Cell[14035, 486, 380, 9, 137, "Input", CellTags->"FIG circle area"], Cell[14418, 497, 130, 3, 60, "Output"] }, Open ]] }, Closed]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[14621, 508, 56, 0, 90, "Section"], Cell[CellGroupData[{ Cell[14702, 512, 97, 1, 74, "Subsection", CellTags->"SUBSEC math model"], Cell[14802, 515, 98, 2, 47, "Text"], Cell[14903, 519, 592, 16, 77, "Input", InitializationCell->True, CellTags->"EQN natcub energy"], Cell[CellGroupData[{ Cell[15520, 539, 65, 1, 60, "Input"], Cell[15588, 542, 39, 1, 60, "Output"] }, Open ]], Cell[15642, 546, 92, 2, 60, "Input", InitializationCell->True], Cell[15737, 550, 153, 3, 47, "Text"], Cell[CellGroupData[{ Cell[15915, 557, 449, 12, 61, "Input", CellTags->"EQN natcub pde"], Cell[16367, 571, 260, 8, 60, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[16676, 585, 121, 1, 53, "Subsection", CellTags->"SUBSEC natural cubic inner product"], Cell[CellGroupData[{ Cell[16822, 590, 64, 0, 60, "Subsubsection"], Cell[16889, 592, 150, 3, 47, "Text"], Cell[CellGroupData[{ Cell[17064, 599, 1570, 26, 230, "Input", CellTags->"FIG finite element plot"], Cell[18637, 627, 135, 3, 60, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[18821, 636, 55, 0, 49, "Subsubsection"], Cell[18879, 638, 343, 12, 82, "Text"], Cell[19225, 652, 253, 4, 47, "NumberedEquation"], Cell[19481, 658, 230, 7, 47, "Text"], Cell[19714, 667, 361, 11, 146, "Input"], Cell[20078, 680, 455, 19, 82, "Text"], Cell[CellGroupData[{ Cell[20558, 703, 475, 8, 186, "Input"], Cell[21036, 713, 583, 11, 146, "Output"] }, Open ]], Cell[21634, 727, 308, 12, 82, "Text"], Cell[CellGroupData[{ Cell[21967, 743, 304, 5, 74, "Input"], Cell[22274, 750, 473, 11, 146, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[22796, 767, 70, 0, 49, "Subsubsection"], Cell[22869, 769, 283, 11, 47, "Text"], Cell[CellGroupData[{ Cell[23177, 784, 397, 9, 122, "Input", InitializationCell->True], Cell[23577, 795, 179, 3, 30, "Message"] }, Open ]], Cell[CellGroupData[{ Cell[23793, 803, 55, 1, 60, "Input"], Cell[23851, 806, 558, 12, 164, "Output"] }, Open ]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[24470, 825, 78, 0, 74, "Subsection"], Cell[24551, 827, 62, 0, 47, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[24650, 832, 97, 1, 74, "Subsection", CellTags->"SUBSEC compute S"], Cell[CellGroupData[{ Cell[24772, 837, 53, 0, 60, "Subsubsection"], Cell[24828, 839, 243, 9, 47, "Text"], Cell[CellGroupData[{ Cell[25096, 852, 145, 2, 60, "Input"], Cell[25244, 856, 451, 10, 128, "Output"] }, Open ]], Cell[25710, 869, 108, 5, 47, "Text"], Cell[25821, 876, 291, 7, 74, "Input", InitializationCell->True, CellTags->"EQN upsampling"], Cell[26115, 885, 122, 5, 47, "Text"], Cell[CellGroupData[{ Cell[26262, 894, 176, 4, 60, "Input"], Cell[26441, 900, 336, 10, 128, "Output"] }, Open ]], Cell[26792, 913, 493, 16, 82, "Text"], Cell[CellGroupData[{ Cell[27310, 933, 478, 8, 186, "Input"], Cell[27791, 943, 181, 3, 30, "Message"], Cell[27975, 948, 467, 12, 164, "Output"] }, Open ]], Cell[28457, 963, 301, 12, 47, "Text"], Cell[CellGroupData[{ Cell[28783, 979, 335, 7, 74, "Input", CellTags->"subd template"], Cell[29121, 988, 437, 12, 224, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[29607, 1006, 68, 0, 49, "Subsubsection"], Cell[29678, 1008, 207, 8, 47, "Text"], Cell[29888, 1018, 764, 14, 252, "Input", InitializationCell->True], Cell[30655, 1034, 31, 0, 47, "Text"], Cell[CellGroupData[{ Cell[30711, 1038, 1873, 34, 333, "Input", CellTags->"FIG differences are zero"], Cell[32587, 1074, 135, 3, 60, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[32759, 1082, 1180, 21, 228, "Input"], Cell[33942, 1105, 135, 3, 60, "Output"] }, Open ]] }, Closed]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[34150, 1116, 57, 0, 90, "Section"], Cell[CellGroupData[{ Cell[34232, 1120, 62, 0, 74, "Subsection"], Cell[CellGroupData[{ Cell[34319, 1124, 55, 0, 60, "Subsubsection"], Cell[34377, 1126, 289, 14, 47, "Text"], Cell[34669, 1142, 177, 4, 60, "Input", InitializationCell->True], Cell[34849, 1148, 149, 5, 47, "Text"], Cell[CellGroupData[{ Cell[