Can I Plot Multiple 2D Graph Slices as a Single Integrated 3D Graph?

Questions
,
1

So, okay, here’s my quandary, I’m working on a problem and have a solution for the even values I’m concerned with, but not yet for the odd values.

What I’d like to do is to graph some range of solutions as individual parts of a 3D graph. Essentially, they’d kind of be 2D cross sections of the incomplete ‘continuous’ 3D graph. If that makes sense. So, basically, I have a function that renders a periodic graph based upon the input of a positive even integer >= 4. So, I’d like to be able to use the function I have to output, say, the graphs where inputs are even integers ‘Z’ between 4 --> 20, and have it give me the resultant 2D graphs (0 <= X <= 2Pi), and then graph all of those 2D graphs in the same 3D space, where the 2D graph is on the X/Y plane, and each such graph is Z units deep in the 3D space.

Does that make sense?

Would I have to use an array or a table? ListPlot3D? How would I structure it?

Here’s a version of my Sigma Function:

z = 6 (*z must be an even integer >= 4.*)
n = z/2
Plot[(Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}]), {x, 0, 2 Pi}, PlotRange -> {0, 1}]

So, what I’m hoping for is that I can specify some range of values and then have Mathematica use the even values inside that range to run the function and then collate the 2D graphs it generates into a single 3D graph, with each slice at its correct z depth. If that makes sense?

Basically I want to plot the even valued graphs, so I can see what the overall plot looks like and makes some educated guesses about what the interstitial odd-valued graphs will look like.

Hope that kind of makes sense? So, is it possible to toss multiple 2D slices into a single 3D graph space? If so, what’s the best way about it?

Best,
~MG

2

I think there used to be a function for this way back in the olden days. Anyway, If you want lines wiggling through 3d space, you usually want ParametricPlot3D.

First I made a function that given an even number, computes the formula for that.
Then I made a list of 3D vector functions which represent the curve I’d want for each of lines.
Then I gave the list of vector functions to ParametricPlot3D.

f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[ Abs[Cos[x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]

funcs = Table[{x, z, f}, {z, 4, 10, 2}];

ParametricPlot3D[funcs, {x, 0, 2 Pi}]

You may want to play with the spacing a bit. Somtimes this is helpful, but it doesn’t look very useful in this case at least. You’d use BoxRatio to change that:

ParametricPlot3D[funcs, {x, 0, 2 Pi}, BoxRatios → {1, 0.3, 1}]

3

Tried that in Mathematica and it came up with a blank cube?

But, not one to be deterred, I changed it to Table[{x, z, f}, …] and that seemed to fix it?

Had to monkey with the settings a bit to get the proportions right-ish. Took me a while to figure out how to get the right info displayed on the various axes. & ended up relabeling the axes 'cause to me the vertical axis should by the Y axis, not the Z axis. But anyway…

GraphStart = 4  (* First graph to plot. Must be even integer. *)
GraphEnd = 60  (* Last graph to plot. Must be even integer. *)
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]
funcs = Table[{x, z, f[z]}, {z, GraphStart, GraphEnd, 2}];
ParametricPlot3D[funcs, {x, 0, 2 Pi}, PlotRange -> {Automatic, {0, GraphEnd}, {0.5, 1}}, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10}, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}} , Ticks -> {Automatic, {2, 4, 6, 8, 10, 12, 14, 16, 18, 20},    Automatic}, PlotPoints -> 200, AxesLabel -> {"x axis", "z axis", "y axis"}]

One minor glitch is labeling the new ‘Z’ axis. I just want the even integer ticks labeled. But, so far, the only way I seem to be able to do that is to manually specify each and every one.

What I’d like to do is simply say something like Even Integers between 0 & ‘GraphEnd.’

I tried inserting a Table into the Ticks parameter like “Ticks->{Automatic,Table[w,{w,0,GraphEnd,2}],Automatic}” but the graph highlighted red and no ticks were labeled. So, clearly that’s not right.

Actually, it does seem to be right. For some reason the first time around it malfunctioned for some reason. Maybe I accidentally deleted a parenthesis or a curly brace or something. Regardless, it didn’t like it. So, here’s more-or-less what I’m working with now:

GraphStart = 4  (* First graph to plot. Must be even integer. *)
GraphEnd = 60  (* Last graph to plot. Must be even integer. *)
TicksTable := Table[t, {t, 0, GraphEnd, 2}];
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]
funcs = Table[{x, z, f[z]}, {z, GraphStart, GraphEnd, 2}];
ParametricPlot3D[funcs, {x, 0, 2 Pi},
PlotRange -> {Automatic, {0, GraphEnd}, {0.5, 1}}, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10}, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}} , Ticks -> {Automatic, TicksTable, Automatic}, PlotPoints -> 200, AxesLabel -> {"x axis", "z axis", "y axis"}]

Seems to more-or-less do what I was hoping it would do…

Though I guess I’m still not sure why it needs to be a ParametricPlot3D as opposed to a ListPlot3D. Or is there a way to accomplish the same thing with ListPlot3D? Dunno…

I guess, as long as it does what I need for visualization, the nuts and bolts can remain something of a mystery. :slight_smile:

Thanks,
~MG

4

Is there a way to do something similar with ListPlot3D that will use those slices, and then try to graph a 3D graph based upon them (interpolating intermediate values)?

I tried something similar but it didn’t come up with anything remotely like the graph I was looking for, so I probably did it totally wrong…

~MG

5

This doesn’t fiddle with the tick labels but I think otherwise does what you request.

Edit. Simple revision which I should have thought of initially and which fixes the tick labels.

ListPlot3D[Flatten[Table[n = z/2; {x, z,(Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[
  Abs[Cos[x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])}, {x, 0, 2 Pi, Pi/128}, {z, 4, 20, 2}], 1]]
6

Also, I made this other graph on my own using the first one as a sort of template (even if I don’t completely understand the precise function; black boxes & all that):

xStart = 0
xEnd = 2 Pi
zStart = 3 (* First graph to plot. Must be even integer. *)
zEnd = 50  (* Last graph to plot. Must be even integer. *)
xTicksTable := Table[xt, {xt, 0, xEnd, Pi/8}];
zTicksTable := Table[zt, {zt, 0, zEnd, 2}];
increment = 1/2
f[z_] := Cos[Pi/z]/Cos[Mod[x, 2 Pi/z] - Pi/z];
func = Table[{x, z, f[z]}, {z, zStart, zEnd, increment}];
ParametricPlot3D[func, {x, xStart, xEnd}, PlotRange -> {Automatic, {0, zEnd}, {0.5, 1}}, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10}, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}} , Ticks -> {xTicksTable, zTicksTable, Automatic}, PlotPoints -> 100, AxesLabel -> {"x axis", "z axis", "y axis"} ]

It utilizes a different form of the same graph (one I don’t like for my final solution due to the Mod[] function, which I find undesirable, but which renders the same results as those I’m looking for). Basically for visualization purposes, so I can try to figure out what the graph is supposed to do and see if there’s a way to do it in my preferred function(s) format.

Clearly, a pattern emerges as one increases zEnd, and/or reduces increment.

Though I’m still not sure how to generalize for all values z >=3 (only know the form for even values of z>=4), at least I know there’s potentially an interesting pattern to be found/generalized. :slight_smile:

Best,
~MG

7

And, with thanks to Bill for the additional ‘template,’ I’ve also constructed the following alternate version of the ListPlot3D based on the Mod[] function:

xStart = 0
xEnd = 2 Pi
yStart = 0.5
yEnd = 1
zStart = 3 (* First graph to plot. Must be >=3. *)
zEnd = 40  (* Last graph to plot. *)
increment = 1/8
xTicksTable := Table[xt, {xt, 0, xEnd, Pi/8}];
yTicksTable := Table[yt, {yt, yStart, yEnd, 1/10}];
zTicksTable := Table[zt, {zt, 0, zEnd, 2}];
ListPlot3D[Flatten[Table[{x, z, (Cos[Pi/z]/Cos[Mod[x, 2 Pi/z] - Pi/z])}, {x, xStart, xEnd, Pi/128}, {z, zStart, zEnd, increment}], 1], PlotRange -> {Automatic, {0, zEnd}, {yStart, yEnd}}, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10}, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, Ticks -> {xTicksTable, zTicksTable, yTicksTable}, AxesLabel -> {"x axis", "z axis", "y axis"}]

Which does a pretty passable job roughing out the 3D shape of whatever the final graph should be, if I ever get it all figured out in my preferred function format… :slight_smile:

Rather interesting to play with.
~MG

8

And, since I could, I also created thsi Plot3D graph of the Mod[] function based graph. Though, strangely, it seems to cut off the tops/ridges of the graph and leave holes you can see down, which is kinda’ weird. Not sure why… Did I do something wrong, or is Mathematica just being finnicky?

xStart = 0
xEnd = 2 Pi
yStart = 0.5
yEnd = 1
zStart = 3 (* First graph to plot. Must be even integer. *)
zEnd = 40  (* Last graph to plot. Must be even integer. *)
xTicksTable := Table[xt, {xt, 0, xEnd, Pi/8}];
yTicksTable := Table[yt, {yt, yStart, yEnd, 1/10}];
zTicksTable := Table[zt, {zt, 0, zEnd, 2}];
Plot3D[(Cos[Pi/y]/Cos[Mod[x, 2 Pi/y] - Pi/y]), {x, xStart, xEnd}, {y,   zStart, zEnd}, PlotRange -> {{xStart, xEnd}, {0, zEnd}, {yStart, yEnd}}, PlotPoints -> 200, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10},  AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, Ticks -> {xTicksTable, zTicksTable, yTicksTable}, AxesLabel -> {"x axis", "z axis", "y axis"}]

Anyway, some interesting visualizations… To me anyway. :slight_smile:

~MG

9

Okay, so I’m still working on ye olde investigation and have decided upon a new tack to the problem of solving for the “odd” functions.

I’ve decided to shift the frequency of all of my graphs down to the same frequency as the first graph, but clearly the amplitude does not match when that happens.

GraphStart = 4  (* First graph to plot. Must be even integer. *) 
GraphEnd = 50  (* Last graph to plot. Must be even integer. *) 
xStart= 0 
xEnd = 2 Pi 
xTicksTable := Table[xt, {xt, 0, xEnd, Pi/8}]; 
zTicksTable := Table[zt, {zt, 0, GraphEnd, 2}]; 
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])] funcs = Table[{x, z, f[z]}, {z, GraphStart, GraphEnd, 2}]; 
ParametricPlot3D[funcs, {x, 0, 2 Pi}, PlotRange -> {Automatic, {0, GraphEnd}, {0.5, 1}}, BoxRatios -> {1, 1, 1}, ViewPoint -> {8, -20, 10},  AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}} , Ticks -> {xTicksTable, zTicksTable, Automatic}, PlotPoints -> 200, AxesLabel -> {"x axis", "z axis", "y axis"}]

So I want to plot some reference points at the same places on each graph slice, and perhaps output their precise values (fractions, with Pi or whatnot) to a table and display the table?

But, it’s been a while since I looked at this and my brain’s a little bit fried. How would I go about something like that?

I’d probably want to say something like for z from GraphStart to GraphEnd, incrementing by 2, at each value of Z, I want to see what the precise value of the function is at the points, say from 0 to 2Pi, incrementing by Pi/8.

So, it would maybe output something like:

for z=4, @Pi/8=datum1, @2Pi/8=datum2, @3Pi/8=datum3, @4Pi/8=datum4, @5Pi/8=datum5, @6Pi/8=datum6, @7Pi/8=datum7, @8Pi/8=datum8, … , @16Pi/8=datum16.
for z=6, @Pi/8=datum17, … , @16Pi/8=datum32
…
for z=GraphEnd, …, etc.

How would I go about adding this extra output table below the 3D function slices graph?

Thanks in advance!

~Michael

10

As a corollary to the above, I’m also trying to mesh several PolarPlot[] graphs into a single PolarPlot graph, but am encountering problems:

So, I try it this way:

GraphStart = 4
GraphEnd = 50
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]
PolarPlotsTable = Table[{PolarPlot[f[z], {x, 0, 2 Pi}]}, {z, GraphStart, GraphEnd, 2}]
ListPolarPlot[PolarPlotsTable]

Or this way:

GraphStart = 4
GraphEnd = 50
f[z_?EvenQ] := With[{n = z/2}, (Sum[ Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[ Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]
PolarPlotsTable = Table[{PolarPlot[f[z], {x, 0, 2 Pi}]}, {z, GraphStart, GraphEnd, 2}]
PolarPlot[PolarPlotsTable, {x, 0, 2 Pi}]

Or even this way:

GraphStart = 4
GraphEnd = 50
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])]
PolarPlotsTable = Table[{PolarPlot[f[z], {x, 0, 2 Pi}]}, {z, GraphStart, GraphEnd, 2}]
Show[{PolarPlotsTable}, {x, 0, 2 Pi}]

…and it shows me the plots sequentially, but fails to merge the graphs.

How do I get it to merge the graphs into a single graph, and maybe NOT show me all the individual graphs individually? Clearly I’m doing or thinking about something wrong…

Best,

~Michael

11

I want to plot some reference points at the same places on each graph slice, and perhaps output their precise values (fractions, with Pi or whatnot) to a table and display the table?

I’d probably want to say something like for z from GraphStart to GraphEnd, incrementing by 2, at each value of Z, I want to see what the precise value of the function is at the points, say from 0 to 2Pi, incrementing by Pi/8.

So, it would maybe output something like:

for z=4, @Pi/8=datum1, @2Pi/8=datum2, @3Pi/8=datum3, @4Pi/8=datum4,
@5Pi/8=datum5, @6Pi/8=datum6, @7Pi/8=datum7, @8Pi/8=datum8, … ,
@16Pi/8=datum16.
for z=6, @Pi/8=datum17, … , @16Pi/8=datum32 …
for z=GraphEnd, …, etc.

How would I go about adding this extra output table below the 3D
function slices graph?

Okay, came up with this:

GraphStart = 4;
GraphEnd = 14;
SamplingRate = Pi/8;
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])];
FunctionValuesTable = Table[{f[z]}, {z, GraphStart, GraphEnd, 2}, {x, 0, Pi, SamplingRate}];
Grid[FunctionValuesTable, Frame -> All]

Seems to get at most of what I’m looking for, though it’s not quite pretty. And the results it spits out seem to in some cases be a bit too simplified (has hoped for everything to be simplified as far as possible in the Cosine format, without necessarily evaluating to radicals, etc.), and other parts feel like they’re maybe not quite simplified enough (or maybe they really are as complicated as they appear)? Hard to tell…

Best,
~MG

12

…the results it spits out seem to in some cases be a bit too simplified (has hoped for everything to be simplified as far as possible in the Cosine format, without necessarily evaluating to radicals, etc.), and other parts feel like they’re maybe not quite simplified enough…

For example:

GraphStart = 4;
GraphEnd = 14;
SamplingRate = Pi/32;
f[z_?EvenQ] := With[{n = z/2}, (Sum[Abs[Cos[((n + 2 + 2 (k - 1)) Pi)/(2 n)]], {k, 1, n}])/(Sum[Abs[Cos[(2/n) x + (((n + 2 + 2 (k - 1)) Pi)/(2 n))]], {k, 1, n}])];
FunctionValuesTable = Table[{f[z]}, {x, 0, Pi, SamplingRate}, {z, GraphStart, GraphEnd, 2}];
Grid[FunctionValuesTable, Frame -> All]
Simplify[Grid[FunctionValuesTable, Frame -> All]]

Even using simplify here, when the simplified grid table comes up, once can see that things are “simplified” inconsistently…

In particular, the 4th column of the 2nd grid / table, where the numerator seems inconsistently simplfied.

Sometimes the left term is simplified to Sqrt[10-2Sqrt[5]], sometimes it’s simplified to Sqrt[2(5-Sqrt[5])], whereas the right term of the numerator appears to ALWAYS simplify to Sqrt[2(5+Sqrt[5])] and NEVER to Sqrt[10+2Sqrt[5]], despite the terms being nearly identical in form.

Likewise, it SOMETIMES leave the Sine / Cosine functions in the denominator, but sometimes switches to a Sqrt[] equivalent value. The Numerator only rarely seems to simplify to the Sine / Cosine functions, and almost always simplifies to some Sqrt[] equivalent…

And it seems to ignore my equation’s original formattingsolely in terms of Cosine, and “simplifies” to a combination of both Sine AND Cosine, which is much harder to parse, since I’d have to figure out which term the Sine’s came from and possibly convert them back to see what’s actually going on.

It’s a bit annoying. Seems like a deficiency in the program to render such inconsistent results? Dunno… Especially things like “factoring,” I mean, one would think it would factor consistently, so as to either ALWAYS render a result like Sqrt[2(5-Sqrt[5])] with the 2 factored out, or ALWAYS render a result of Sqrt[10-2Sqrt[5]] with the 2 multiplied out across the inner terms. Weird that it doesn’t handle these things consistently…

Yeah?