       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:

    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.

    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]

    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.

    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