10
$\begingroup$

I like the default functionality of ListLinePlot3D's layering of 2-d data plots, as seen below with 4 layers.

ListLinePlot3D[
{{2.1, 2.9, 2.8, 1.9, 1.1, 1.2, 2.1}, 
{2.2, 2.7, 1.1, 2.2, 2.7, 1.1, 2.2}, 
{2.3, 1.7, 2.3, 1.7, 2.3, 1.7, 2.3}, 
{2.4, 1., 2.6, 2.4, 1., 2.6, 2.4}}, 
Filling -> Axis]

ListLinePlot3D pic

However, this visual becomes unwieldy with many layers. I would love to have the ability to "scroll through" layers in groups of some size k.

For example, say I have 50 layers total and I do not want to show all 50 of them at once because the visuals would look overwhelming. I would like to show k=5 layers at any one time, and then scroll through the 50 layers, 5 at a time. So at the beginning, layers (1-5) would show. When I scroll a bit further, layers (2-6) would show. After scrolling through to the end, layers (46-50) would show.

Bonus Points

What would really be cool is to have the group of say, k=5 layers showing and then, say, j=2 more "hanging layers" in front and in back showing, but these layers are translucent. This way the user can see better what he is scrolling through. For example, the plot with its axes would be fixed in the center, and then the data layers would roll through, whereby, say layers 11-15 can be fully seen in the plot, and layers 9 and 10 are translucent in front, while layers 16 and 17 are translucent in back.

After scrolling, layers 23-27 can be fully seen in the plot, and layers 21 and 22 are translucent in front, while layers 28 and 29 are translucent in back. In the beginning, no translucent hanging layers would be in front and at the end, no translucent hanging layers would be in back.

This is somewhat similar to how time machine on Macs visually slides between windows, if you are familiar (see 8:10 here).

I am open to other nice, visually appealing variations or ideas.

Update

The answers so far are great. I am also wondering if the scrolling can be smooth, so that the layers look like they are smoothly scrolling through the axes/box.

$\endgroup$

3 Answers 3

5
$\begingroup$
SeedRandom[1];
data = RandomReal[5, {50, 10}];

For smooth scrolling

  1. Create a plot of all data using ListLinePlot3D and post-process to add filling polygons with matching colors:

addFilling = ReplaceAll[Line[x_] :> 
 {Line[x], Opacity[.2], EdgeForm[], 
  Polygon[Join[{Append[0] @ x[[1, 1,;; 2]]}, x[[1]], {Append[0] @ x[[1,- 1,;; 2]]}]]}]

plot = addFilling @ ListLinePlot3D[MapIndexed[Tooltip]@data,
  SphericalRegion -> True, 
  PlotRegion -> {{0, 1}, {-.2, 1.2}},
  Boxed -> {Back, Bottom, Left},
  ViewPoint -> {3, -1, 1}, 
  ImageSize -> Large, 
  AxesEdge -> {{1, 1}, {1, -1}, {1, 1}},
  PlotRangePadding ->.5, 
  Ticks -> {Range[10], Range[50], Range[0,6]} ,
  PlotStyle -> (ColorData[97] /@ Range[50])];
  1. Use plot with Show with a smoothly varying PlotRange:

Manipulate[Show[plot, PlotRange ->{{0, 10}, {t, t + ww}, {0, 6}}], 
 {{ww, 5, "window width"}, Range[3, 20], SetterBar}, 
 {{t, 0, "animation"}, 0, .5 + Length@data - ww, .05,
    Animator, DisplayAllSteps -> True, AnimationRunning -> False, AnimationRate -> 20}, 
 Alignment -> Center]

enter image description here

Notes:

  • The reason for post-processing to add polygons: If, instead, we use the option Filling in ListLinePlot3D with many lines there is a mismatch between line and polygon styles (This seems to be a bug).
  • We explicitly map ColorData[97] on Range[50] to get distinct colors for each line. If we use the default plot style (or use PlotStyle - > 97) the colors cycle thru a shorter list giving duplicate colors. (Furthermore, when Filling -> Axis is used, the filling colors are also cyclic but with a different cycle - possible source of / contributor to the bug mentioned above).
  • The option SphericalRegion and explicit PlotRange and Ticks is to avoid flickering in animation.
  • The option PlotRegion is used to trim the white space above and below the main plot.
$\endgroup$
3
  • $\begingroup$ This is great. Do you happen to know why the filling color for layers 11 and 12 don't match the curve color? They are the only layers like that. $\endgroup$ Mar 31, 2022 at 21:13
  • 1
    $\begingroup$ @JustSomeOldMan, good eye-sight for JustSomeOldMan:) Don't know why -- I will check. $\endgroup$
    – kglr
    Mar 31, 2022 at 22:07
  • 1
    $\begingroup$ @JustSomeOldMan, the mismatch between line and filling colors seems to be a bug (actually many other layers have the same issue but is takes harder squinting to see them). I updated with a work-around that avoids this issue. $\endgroup$
    – kglr
    Apr 1, 2022 at 13:36
10
$\begingroup$
$Version

(* "13.0.1 for Mac OS X x86 (64-bit) (January 28, 2022)" *)

Clear["Global`*"]

SeedRandom[1234];

data = RandomReal[2.5, {50, 7}];

Manipulate[
 ListLinePlot3D[data[[n ;; n + 4]],
  Filling -> Axis,
  DataRange -> {{1, Length[data[[1]]]}, {n, n + 4}}],
 {{n, 1}, 1, Length[data] - 4, 1,
  Appearance -> "Labeled"}]

enter image description here

$\endgroup$
1
  • $\begingroup$ Elegant and efficient. $\endgroup$ Mar 28, 2022 at 23:48
6
$\begingroup$

enter image description here

ClearAll[llp3D]
llp3D[dt_, col_: 97][i1_, i2_, pad_: 1, o : OptionsPattern[]] := Module[{min = Min[dt], 
   xyz = Select[i1 - pad <= #[[1, 2]] <= i2 + pad &]@
      MapIndexed[Flatten[{Reverse@#2, #}] &, dt, {2}], 
   colors = AssociationThread[Range[Length @ dt], 
      Switch[col, _List, col, 
        _Integer, ColorData[col] /@ Range[Length @ dt], 
        _String,  ColorData[col] /@ Rescale[Range[Length@dt]]]]}, 
  Graphics3D[Map[{JoinForm["Round"], CapForm["Round"], Thin, colors@#[[1, 2]],
      #[[1, 2]] /. {Alternatives @@ Range[i1, i2] -> Tube[#, .05], _ ->  Line[#]}, 
      EdgeForm[], Opacity[#[[1, 2]] /. {Alternatives @@ Range[i1, i2] -> .2, _ -> .05}],
      Polygon[Join[{Append[min]@#[[1, ;; 2]]}, #, {Append[min]@#[[-1, ;; 2]]}]]} &]@xyz,
   o, PlotRangePadding -> Scaled[.1], Lighting -> "Neutral", Axes -> True, 
   Ticks -> {Automatic, Range[i1 - pad, i2 + pad], Automatic}, 
   BoxRatios -> {1, 1, 1/2}]]

Examples:

SeedRandom[1];
data = RandomReal[5, {50, 10}];

llp3D[data][2, 15, 2, BoxRatios -> Automatic, Boxed -> {Back, Bottom, Left}, 
  PlotRangePadding -> Scaled[.01], ImageSize -> Large]

enter image description here

pad = 2; ww = 4; nmax = Length@data;

yrange[d_, ww_, pad_] := {Max[1, Min[nmax - ww - 2 pad, # - pad]], 
   Min[nmax, Max[# + ww + pad, ww + 2 pad + 1]]} &; 

Manipulate[llp3D[data][m, m + ww, pad, 
  ViewPoint -> {3, -1, 1}, 
  ImageSize -> Large,
  Boxed -> {Back, Bottom, Left}, 
  PlotRangePadding -> 1, 
  PlotRange -> {All, yrange[data, ww, pad]@m, Round[MinMax@data]}, 
  Ticks -> {Automatic, Range @@ yrange[data, ww, pad]@m, Range[0, 6]}], 
 Grid[{{Dynamic[Pane[StringPadLeft[ToString@m, 3], ImageSize -> {21, 15}]], 
    Control@{{m, 1, ""}, 1, nmax - ww, 1, Appearance -> "Open"}, 
    Dynamic[Pane[StringPadLeft[ToString[m + ww], 3], 
      ImageSize -> {21, 15}]]}}, 
   Spacings -> 1, Alignment -> {{Right, Right, Right}, Center}]]

enter image description here

The animation at the top produced using

frames = Table[llp3D[data][m, m + ww, pad, ViewPoint -> {3, -1, 1}, 
   ImageSize -> Large, Boxed -> {Back, Bottom, Left}, PlotRangePadding -> 1, 
   PlotRange -> {All, yrange[data, ww, pad]@m, Round[MinMax@data]}, 
   Ticks -> {Automatic, Range @@ yrange[data, ww, pad]@m, Range[0, 6]}], 
  {m, 1, 45}];

Export["llp3dwindows.gif", frames]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.