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.