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?
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityYou 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?
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]
}
shadow[prims_] :=
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}]}}
]
DropShadow[g_Graphics] := Graphics[{shadow[First[g]], First[g]}, Options[g]]
DropShadow[
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.
Blur
. Would that be better in your code than using several lines with different opacity?
$\endgroup$
Mar 16, 2012 at 21:54
Here are some financial data:
data = FinancialData["GE", {2000, 1, 1}]
Hard-edge shadow
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]
Soft-edge shadow
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}]
GridLinesStyle -> Directive[Opacity[.5], GrayLevel[.5]]
The right interplay between Opacity
and GrayLevel
can produce very nice looking plot.
$\endgroup$
Mar 16, 2012 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[{
Graphics[{Arrow[{{0, 0}, shadowDirection}]}],
Reverse@
Table[ListLinePlot[# + translateFactor*shadowDirection & /@
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},
{{shadowDirection, {1.5, -1}}, Locator},
{{smoothThickness, 3.5}, 1, 5}
]
]
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},
{x, y} = pad;
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}
]
Inset
and Prolog
vs. Overlay
or is this personal preference?
$\endgroup$
Mar 17, 2012 at 4:25
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.
$\endgroup$
Mar 17, 2012 at 4:31
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}]