Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I would like to generate something like 3D Line Chart in Excel. Like the following figure

enter image description here

but including third coordinates.

Example

I have a set of 2D data combied with 1D spatial data.

dxy = {{{0, 5.5`, 71.53`}, {0, 7.5`, 42.25`}, {0, 11.5`, 15.85`}, {0, 
     15.5`, 20.33`}, {0, 18.`, 43.555200000000006`}, {0, 
     22.833333333333332`, 24.47`}}, {{10.`, 5.5`, 48.5`}, {10.`, 7.5`,
      40.44`}, {10.`, 11.5`, 14.69`}, {10.`, 15.5`, 14.65`}, {10.`, 
     18.`, 42.9104`}, {10.`, 22.833333333333332`, 24.16`}}, {{425.`, 
     5.5`, 44.46`}, {425.`, 7.5`, 83.82`}, {425.`, 11.5`, 
     21.88`}, {425.`, 15.5`, 71.99`}, {425.`, 18.`, 63.65`}, {425.`, 
     22.833333333333332`, 45.32`}}, {{650, 5.5`, 64.52`}, {650, 7.5`, 
     65.36`}, {650, 11.5`, 20.0512`}, {650, 15.5`, 66.8`}, {650, 18.`,
      38.6984`}, {650, 22.833333333333332`, 30.3`}}, {{700, 5.5`, 
     105.49`}, {700, 7.5`, 118.6`}, {700, 11.5`, 17.1288`}, {700, 
     15.5`, 43.39`}, {700, 18.`, 29.276`}, {700, 22.833333333333332`, 
     23.18`}}, {{1300, 5.5`, 35.98`}, {1300, 7.5`, 
     59.976800000000004`}, {1300, 11.5`, 35.2768`}, {1300, 15.5`, 
     45.09`}, {1300, 18.`, 7.872800000000001`}, {1300, 
     22.833333333333332`, 7.86`}}};

ListPointPlot3D[dxy, Filling -> Bottom, 
 AxesLabel -> {"Distance", "Time", "Value"}, 
 LabelStyle -> Directive[Bold]]

enter image description here

Almost does what I wanted, but I cannot connect the dots by options. If I use Line, I have to do the coloring manually. I plan to apply the code for more different size datasets.

ListPlot3D[dxy]

Gives an empty graph. Surprisingly, if I change the order of coordinates it works.

xyd = dxy /. {a_, b_, c_} -> {b, c, a}
{{{5.5, 71.53, 0}, {7.5, 42.25, 0}, {11.5, 15.85, 0}, {15.5, 
 20.33, 0}, {18., 43.5552, 0}, {22.8333, 24.47, 0}}, {{5.5, 48.5, 
 10.}, {7.5, 40.44, 10.}, {11.5, 14.69, 10.}, {15.5, 14.65, 
 10.}, {18., 42.9104, 10.}, {22.8333, 24.16, 10.}}, {{5.5, 44.46, 
 425.}, {7.5, 83.82, 425.}, {11.5, 21.88, 425.}, {15.5, 71.99, 
 425.}, {18., 63.65, 425.}, {22.8333, 45.32, 425.}}, {{5.5, 64.52, 
 650}, {7.5, 65.36, 650}, {11.5, 20.0512, 650}, {15.5, 66.8, 
 650}, {18., 38.6984, 650}, {22.8333, 30.3, 650}}, {{5.5, 105.49, 
 700}, {7.5, 118.6, 700}, {11.5, 17.1288, 700}, {15.5, 43.39, 
 700}, {18., 29.276, 700}, {22.8333, 23.18, 700}}, {{5.5, 35.98, 
 1300}, {7.5, 59.9768, 1300}, {11.5, 35.2768, 1300}, {15.5, 45.09, 
 1300}, {18., 7.8728, 1300}, {22.8333, 7.86, 1300}}}
ListPlot3D[xyd]

enter image description here

Works, but -of course - with wrong connections.

Dimensions[dxy] == Dimensions[xyd] is obviously True, Options[] of the outputs are similar. I do not understand the difference.

share|improve this question
    
What nobody has mentioned so far is that this chart is an absolutely terrible way of presenting quantitative information. Although the answers show very well that one can produce it in Mathematica, I would still avoid actually using it, if I were you. –  Oleksandr R. May 10 at 22:40

4 Answers 4

up vote 2 down vote accepted

This is a bit sneaky and likely to break with new versions, but here you go:

ListPointPlot3D[dxy, Filling -> Bottom, 
  AxesLabel -> {"Distance", "Time", "Value"}, 
  LabelStyle -> Directive[Bold]] /. p : _Point :> {p, Line @@ p}

Mathematica graphics

share|improve this answer
    
Nice and compact, thanks. –  Vica May 9 at 9:26
    
Although these are lines, not planes.. –  Öskå May 9 at 9:27
    
@Öskå knock yourself out - ´s not far away ;-) In fact, the OP mentioned that lines would be just fine... –  Yves Klett May 9 at 11:00
    
"Almost does what I wanted" Let's reach the That's exactly what I wanted ;o) :D –  Öskå May 9 at 11:03
    
@Öskå strict adherance to the pareto principle here (har har, if only!). –  Yves Klett May 9 at 11:13

For Mathematica versions <9 use Table[Blend["Rainbow", i], {i, 0, 1, 1/(Length@dxy - 1.)}] instead of Array for colors.

Edit: Thanks to Öskå encouragement I've updated answer so now it fits OP's example well.

  With[{
  w = 60,
  colors = Array[Blend["Rainbow", #] &, Length@dxy, {0, 1}],
  opt = Sequence[BoxRatios -> 1, ViewVertical -> {0, 0, 1}, AxesLabel -> {x, y, z},
                 Axes -> True, ViewPoint -> {2.2, 2, 1.5}, Boxed -> False,
                 FaceGrids -> {{{-1, 0, 0}, {{}, Range[0, 120, 40]}}, {{0, -1, 0},
                               {{}, Range[0, 120, 40]}}},
                 PlotRange -> {0, All}, BaseStyle -> {Bold, 18}, ImageSize -> 400]
  },
 Grid[{{
    Graphics3D[{EdgeForm@Opacity[.33],
     Riffle[colors,
      (Polygon[Join[#, # + {w, 0, 0} & /@ Reverse@#]] & /@ Partition[#, 2, 1]) & /@ dxy]
     }, opt]
    ,
    SwatchLegend[colors, Table[StringForm["data_``", i], {i, Length@dxy}]]
    }}, BaseStyle -> {18, Bold}]]

enter image description here

share|improve this answer

This is not as beautiful or finessed as Kuba (though I borrowed color scheme) I post for little variant:

rbn[pts_, i_, opts___] := Module[{up, dn},
  up = Partition[# + {i, 0, 0} & /@ pts, 2, 1];
  dn = Partition[# - {i, 0, 0} & /@ pts, 2, 1];
  MapThread[{opts, Polygon[Join[#1, Reverse@#2]]} &, {up, dn}]
  ];

Example 1:

Manipulate[
 Graphics3D[rbn[#, inc, FaceForm[Red]] & /@ dxy, 
  BoxRatios -> {2, 2, 1}, Axes -> True], {inc, 20, 50}]

enter image description here

Example 2:

Graphics3D[
 MapThread[
  rbn[#1, 40, #2] &, {dxy, 
   Array[Blend["Rainbow", #] &, Length@dxy, {0, 1}]}], 
 BoxRatios -> {2, 2, 1}, ImageSize -> 400]

enter image description here

share|improve this answer
ClearAll[lnChrt];
lnChrt[dt_, w_, opts : OptionsPattern[]] :=
  ListPlot3D[(# /. {x_, y_, z_} :>Sequence[{x + w/2, y, z}, {x - w/2, y, z}])&/@dt, opts]

options = {Mesh -> None, Filling -> Axis, FillingStyle -> Opacity[.4],
        BoxRatios -> {3, 3, 2}, ImageSize -> 500}; 
lnChrt[dxy, 40, PlotStyle -> ColorData[1, "ColorList"], options]

enter image description here

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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