Re: Combining 2D graphs into a 3D graph

*To*: mathgroup at smc.vnet.net*Subject*: [mg49793] Re: Combining 2D graphs into a 3D graph*From*: "Peltio" <peltio at twilight.zone>*Date*: Sun, 1 Aug 2004 04:09:57 -0400 (EDT)*References*: <cddpep$pcp$1@smc.vnet.net> <cdj28e$nd6$1@smc.vnet.net> <cefhlm$bu8$1@smc.vnet.net>*Reply-to*: "Peltio" <peltioNOSP at Mdespammed.com.invalid>*Sender*: owner-wri-mathgroup at wolfram.com

I hang my post here since I no longer have the OP's post. The OP wrote: >> 2. Is there a way for me to fit a surface to the family of curves I >> have? Being able to stack the curves is good enough, but I guess my >> boss will have this further suggestion. Looks like a transfinite interpolation problem. I once wrote some code to perform ordinary cartesian transfinite interpolation: [1] Interpolating two functions (f1[x], f2[x])along the same direction ( at y=a and y=) is straightforward: F[x_, y_] = (y - b)/(a - b) f1[x] + (y - a)/(b - a) f2[x] So let's move on. [2] The generalization to several functions could use the Lagrange functions to create a connection in the orthogonal direction (an alternative could be a piecewise transfinite interpolation, but I did not feel like to venture that far, at the time) L[x_Symbol, k_Integer] := ( (Times @@ (x - Drop[#, {k}]))/(Times @@ (#[[k]] - Drop[#, {k}])) )& TransfiniteInterpolation[Fxj_List, {x_Symbol, xj__}] := Fxj.Table[L[x, j][{xj}], {j, 1, Length[{xj}]}] The example given in the post I am answering tis using fourth degree polynomials, since there are five 'function lines' to interpolate: dd[x_, y_] = TransfiniteInterpolation[{Sin[x], Sin[2 x], Cos[x], Cos[x + Pi/3], Cos[x + Pi/2]}, {y, 1, 2, 3, 4, 5}] Plot3D[dd[x, y], {x, -Pi, Pi}, {y, 1, 5}, PlotPoints -> 50, Mesh -> False] [3] To interpolate several functions along orthogonal directions the following code could be used: TransfiniteInterpolation[ {Fxj_List, Fyk_List}, {x_Symbol, xj__}, {y_Symbol, yk__}] := Module[ {Lxj, Lyk, xvals, yvals}, xvals = {xj}; yvals = {yk}; Lxj = Table[L[x, j][xvals], {j, 1, Length[xvals]}]; Lyk = Table[L[y, k][yvals], {k, 1, Length[yvals]}]; Lxj.Fxj + Lyk.Fyk - Plus @@ Flatten[ Outer[Times, Lxj, Lyk] Outer[ReplaceAll, Fxj, Rule[y, #] & /@ yvals]] ] An example with a 3 x 3 grid of functions is: F[x_, y_] = TransfiniteInterpolation[ {{Sin[y], 1 - Sin[y], Sin[y]}, {Sin[x], 1 - Sin[x], Sin[x]}}, {x, 0, Pi/2, Pi}, {y, 0, Pi/2, Pi} ] // FullSimplify Plot3D[F[x, y], {x, 0, Pi}, {y, 0, Pi}] None of the procedures performs a check of the consinstency of the data passed to it. The values of the functions at the intersections points should be consistent. [4] To interpolate only two functions delimiting a rectangular domain I had an 'ad hoc' code, later superseded by the general form given above. I kept the procedure to plot the four functions at the boundaries of the rectangular domain: ShowTransfiniteInterpolation[{{fw_, fe_}, {fs_, fn_}}, {x_Symbol, x1_, x2_}, {y_Symbol, y1_, y2_}] := ( Block[ {$DisplayFunction = Identity, style = {Thickness[.01], Hue[.84]}, F}, F = TransfiniteInterpolation[{{fw, fe}, {fs, fn}}, {x, x1, x2}, {y,y1, y2}]; surf = Plot3D[F, {x, x1, x2}, {y, y1, y2}, Mesh -> False, PlotPoints -> 35]; Print[F]; lw = ParametricPlot3D[{x1, y, fw, style}, {y, y1, y2}]; le = ParametricPlot3D[{x2, y, fe, style}, {y, y1, y2}]; ls = ParametricPlot3D[{x, y1, fs, style}, {x, x1, x2}]; ln = ParametricPlot3D[{x, y2, fn, style}, {x, x1, x2}]; ]; Show[{surf, le, lw, ls, ln}, DisplayFunction -> $DisplayFunction]; ) Try this ShowTransfiniteInterpolation[ {{Sin[y], Cos[y]}, {Sin[x/2], Sin[3/2x]}}, {x, 0, Pi}, {y, 0, Pi} ] Hope the code is not too rusty. : ) cheers, Peltio Invalid address in reply-to. Crafty demunging required to mail me.