# How to create Line Chart with real third coordinates?

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

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]]


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]


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.

-
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 '14 at 22:40

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}


-
Nice and compact, thanks. – Vica May 9 '14 at 9:26
Although these are lines, not planes.. – Öskå May 9 '14 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 '14 at 11:00
"Almost does what I wanted" Let's reach the That's exactly what I wanted ;o) :D – Öskå May 9 '14 at 11:03
@Öskå strict adherance to the pareto principle here (har har, if only!). – Yves Klett May 9 '14 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}]]


-

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}]


Example 2:

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


-
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]


-