# How can I make a 2D line plot with a drop shadow under the line?

You often see plots styled like this (ignore the bar chart component):

i.e. with a small drop shadow under the line. (I'm assuming Excel is being used to produce these plots).

How could you make something similar in Mathematica?

-
Microsoft obviously didn't start talking to Edward Tufte either, at least not till they put sparklines in Excel 2010. – Verbeia Mar 15 '12 at 22:17
default Excel plots do seem to be (IM subjective O) a significant improvement on than the old days. But guess what they can do two axis plots "out-of-the-box" -- you need to write code to do this simple everyday task in Mma. So at least they provide "out of the box" tools for the most commonly used plots. – Mike Honeychurch Mar 15 '12 at 22:23
Does the drop-shadow really add anything to the plot? Or is it just "chart junk" -- the kind of thing that Tufte would excoriate? – murray Mar 17 '12 at 15:49
@murray this, and other similar questions, are more interesting to me from a programming point of view than an aesthetics point of view. It is nice to see what people come up with. – Mike Honeychurch Mar 17 '12 at 20:39

This solution creates copies of the original curve that use coordinates shifted by Offset to have the shadow behave the same regardless of the scale of the coordinates. It uses multiple copies of the original, in varying thicknesses, opacities, and offsets. It also uses JoinForm["Round"] to avoid sharp corners in the shadow.

offset[p_, o_] := Offset[o, #] & /@ p

offsetPrims[prims_, o_] :=
prims /. {
GraphicsComplex[p_, r__] :> GraphicsComplex[offset[p, o], r],
Line[p_, r___] :> Line[offset[p, o], r]
}

With[{bare = DeleteCases[prims, _Hue | _RGBColor, Infinity]},
{Black, JoinForm["Round"],
{AbsoluteThickness[5], Opacity[0.05], offsetPrims[bare, {3, -3}]},
{AbsoluteThickness[4], Opacity[0.1], offsetPrims[bare, {2, -2}]},
{AbsoluteThickness[3], Opacity[0.1], offsetPrims[bare, {1, -1}]}}
]

DateListPlot[
{FinancialData["GOOG", "Close", {{2009, 5, 1}, {2010, 4, 30}}],
FinancialData["AAPL", "Close", {{2009, 5, 1}, {2010, 4, 30}}]},
Joined -> True]]


This could be extended to work with points and polygons as well.

-
I like the look of this @Brett. I also like Vitaly's use of Blur. Would that be better in your code than using several lines with different opacity? – Mike Honeychurch Mar 16 '12 at 21:54
@MikeHoneychurch I went ahead and created a new answer. Adding it to either my or Vitaliy's existing answers would have made them a bit cumbersome, I think. – Brett Champion Mar 17 '12 at 3:38

Based on Mike's feedback, here's a general Blur approach. Unlike Vitaliy's solution, this uses Inset and Prolog to include the blurred shadow in the actual graphic, instead of using Overlay.

BlurShadow[p_, size_: 5, pad_: {3, 15}] := Block[{blur, x, y},
blur = Show[p, Frame -> False, Axes -> False, GridLines -> None],
blur = Blur[blur, size];
blur = ImagePad[blur, {{x, -x}, {-y, y}}, Automatic];
blur = SetAlphaChannel[
ColorConvert[blur, "GrayScale"],
ColorNegate[Binarize[blur]]];
Show[p, Prolog -> {
Inset[blur, {Right, Top}, {Right, Top}, Scaled[{1, 1}]]
}]
]


Try it out a bit:

BlurShadow[
DateListPlot[{
FinancialData["GOOG", "Close", {{2009, 5, 1}, {2010, 4, 30}}],
FinancialData["AAPL", "Close", {{2009, 5, 1}, {2010, 4, 30}}]
}, Joined -> True, PlotStyle -> Thick],
7,
{3, 20}
]


BlurShadow[
DateListPlot[FinancialData["GE", {2000, 1, 1}],
Joined -> True, ImageSize -> 400,
PlotStyle -> Directive[Thickness[.004], Darker@Red],
AspectRatio -> 1/3, GridLines -> Automatic],
5,
{3, 22}
]


-
is there an advantage to using Inset and Prolog vs. Overlay or is this personal preference? – Mike Honeychurch Mar 17 '12 at 4:25
There are two or that I can think of. The result remains a graphic, so can be used with Show, etc... The other is that the gridlines are better positioned, as I understood one of your other comments. I think Inset also provides better sizing and positioning of the shadow. – Brett Champion Mar 17 '12 at 4:31

Here are some financial data:

data = FinancialData["GE", {2000, 1, 1}]


To make shadow put a slightly shifted down gray transparent copy of the curve under the original one. To make affect more subtle tune up Opacity[...] and other options. A small automation trick to answer @MikeHoneychurch comment - we use not a custom, but automated 0.1% of vertical width shift down. Other automation can be done (opacity, shadow width, etc), but I wanted to keep code simple.

DateListPlot[{{#[[1]], #[[2]] - .1 (Max[#] - Min[#])/100} & /@data,data},
Joined -> True,PlotStyle -> {Directive[Opacity[.4], Thickness[.01], Gray],
Directive[Thickness[.004],Darker@Red]},AspectRatio->1/3, GridLines->Automatic]


Similar approach using Overlay and Blur. This makes shadow nicely soft.

a = DateListPlot[data, Joined -> True, PlotStyle -> Directive[Thickness[.004],
Darker@Red], AspectRatio -> 1/3, GridLines -> Automatic, ImageSize -> 400];

b = Blur[DateListPlot[data, Joined -> True, PlotStyle -> Directive[
Opacity[.85], Thickness[.009], Gray], AspectRatio -> 1/3, Frame ->
False, Axes -> False, ImageSize -> 380], 5];

Overlay[{b, a}, Alignment -> {.7, -.5}]


-
I tried something similar. Automation would require offsetting by some fixed % rather than an absolute amount. – Mike Honeychurch Mar 15 '12 at 22:50
@MikeHoneychurch I added a soft shadow and a slight automation examples. Of course much more automation can be added including opacity, shadow width, vertical drop, etc. – Vitaliy Kaurov Mar 16 '12 at 6:00
@VitaliyKaurov Nice way of adding the blur effect. Can you make the gridlines as background? Maybe three overlayed instead of two? – P. Fonseca Mar 16 '12 at 7:03
@P.Fonseca Thanks. To better blend gridlines with shadow we can use something like GridLinesStyle -> Directive[Opacity[.5], GrayLevel[.5]] The right interplay between Opacity and GrayLevel can produce very nice looking plot. – Vitaliy Kaurov Mar 16 '12 at 7:17

I'm sure there is a way of automating what I'm posting, but this can give you a general idea.

data = Table[{x, Sin[x] + RandomReal[]*0.2}, {x, 0, 2 Pi, Pi/50}];

g1 = ListPlot[data, Joined -> True,
PlotStyle -> {Thickness[0.01], RGBColor[0.7, 0.2, 0.2]}];

g2 = ListPlot[# + {+0.015, -0.015} & /@ data, Joined -> True,
PlotStyle -> {Thickness[0.01], RGBColor[0.7, 0.7, 0.7]}];

g3 = ListPlot[# + {+0.03, -0.03} & /@ data, Joined -> True,
PlotStyle -> {Thickness[0.01], RGBColor[0.9, 0.9, 0.9]}];

Show[g3, g2, g1]


Edit by halirutan: My answer would have based on the same idea, so instead of writing one myself, let me point out, what makes this approach IMO so nice looking. It is the effect, of having not a hard shadow, but a shadow where the edges are smoothed out. In reality there are rarely situations, where you have really hard edged black shadows and therefore a decent, slightly blurred shadow looks in graphs very nice too.

There are some free parameters, for instance the shadow position, its darkness, the grade of the blurring. If I would have to write a function, which does the same what is shown above, I would maybe use a Table, to create plots of the data with decreasing thickness and increasing darkness. Combining them gives a shadow as smooth as you like it. Adding your real plot over it and you are done:

With[{
data = Table[{x, Sin[x] + RandomReal[]*0.2}, {x, -Pi, Pi, Pi/50}],
grayLevels = 10
},
Manipulate[
With[{
ddark = (1 - darkness)/grayLevels,
baseThick = 0.01,
translateFactor = 0.1
},
Show[{
Reverse@
data, PlotStyle -> {Thickness[
Rescale[
g, {darkness, 1 - ddark}, {baseThick,
baseThick*smoothThickness}]],
GrayLevel[g]}], {g, darkness, 1 - ddark, ddark}
],
ListLinePlot[data, PlotStyle -> {Thickness[baseThick], Red}]
}, PlotRange -> {{-Pi, Pi}, {-2, 2}}, Axes -> True]
],
{{darkness, 0.4}, 0, 0.7},
{{smoothThickness, 3.5}, 1, 5}
]
]


-
the additional line you've added creates a nicer effect. – Mike Honeychurch Mar 15 '12 at 22:53
+1 Sorry for adding stuff to your answer, but I thought the main point, why it is so cool was not stressed out enough and I really like the approach. – halirutan Mar 16 '12 at 1:25
Nice, I especially like the manipulate! – tkott Mar 16 '12 at 2:11
@halirutan thank you for the added value to my very basic answer. You helped me pass the barrier of 500 reputations :-) (feeling a little less amateur...) – P. Fonseca Mar 16 '12 at 6:56
To my eye, having the plot stick out as if in a 3rd dimension and cause a shadow to fall on the plane behind it is truly "chart junk": superfluous artistic design having no legitimate purpose with regard to revealing anything about the data. – murray Mar 17 '12 at 15:51

Here's a way to do things using Filling that is similar to Mike's approach:

data = Table[{x, Sin[x] + RandomReal[]*0.2}, {x, 0, 2 Pi, Pi/50}];
{xMax, xMin} = {Max@data[[All, 1]], Min@data[[All, 1]]};
{yMax, yMin} = {Max@data[[All, 2]], Min@data[[All, 2]]};
data2 = Plus[{.01 (xMax - xMin), -0.01 (yMax - yMin)}, #] & /@ data;

ListPlot[{data, data2}, Joined -> True,
Filling -> {1 -> {{2}, {Directive[Gray, Opacity[0.5]]}}},
PlotStyle -> {{Thickness[0.01], RGBColor[0.7, 0.2, 0.2]}, None}]


Which produces:

Here is an example that uses the ideas in this gradient plot question. However, they're not perfect, and I'm a little tired to dig in and make it great:

ListPlot[data, Joined -> True,
Prolog ->
Polygon[Join[data, data2],
VertexColors ->
Join[Blend[{Black, White}, #] & /@ (data[[All, 2]] -
data2[[All, 2]]), ConstantArray[White, Length[data]]]],
PlotStyle -> {{Thickness[0.01], RGBColor[0.7, 0.2, 0.2]}, None}]


-
+1 nice use of blending/gradient. – Mike Honeychurch Mar 16 '12 at 2:05
Thanks!, it doesn't quite work as well as I expected, but oh well. – tkott Mar 16 '12 at 2:12