26
$\begingroup$

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

enter image description here

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?

$\endgroup$
4
  • 6
    $\begingroup$ Microsoft obviously didn't start talking to Edward Tufte either, at least not till they put sparklines in Excel 2010. $\endgroup$
    – Verbeia
    Mar 15, 2012 at 22:17
  • 1
    $\begingroup$ 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. $\endgroup$ Mar 15, 2012 at 22:23
  • 2
    $\begingroup$ Does the drop-shadow really add anything to the plot? Or is it just "chart junk" -- the kind of thing that Tufte would excoriate? $\endgroup$
    – murray
    Mar 17, 2012 at 15:49
  • $\begingroup$ @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. $\endgroup$ Mar 17, 2012 at 20:39

5 Answers 5

12
$\begingroup$

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

enter image description here

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

$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$ Mar 16, 2012 at 21:54
  • $\begingroup$ @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. $\endgroup$ Mar 17, 2012 at 3:38
21
$\begingroup$

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]

enter image description here

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

enter image description here

$\endgroup$
4
  • $\begingroup$ I tried something similar. Automation would require offsetting by some fixed % rather than an absolute amount. $\endgroup$ Mar 15, 2012 at 22:50
  • $\begingroup$ @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. $\endgroup$ Mar 16, 2012 at 6:00
  • $\begingroup$ @VitaliyKaurov Nice way of adding the blur effect. Can you make the gridlines as background? Maybe three overlayed instead of two? $\endgroup$
    – P. Fonseca
    Mar 16, 2012 at 7:03
  • $\begingroup$ @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. $\endgroup$ Mar 16, 2012 at 7:17
14
$\begingroup$

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]

enter image description here

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

enter image description here

$\endgroup$
5
  • $\begingroup$ the additional line you've added creates a nicer effect. $\endgroup$ Mar 15, 2012 at 22:53
  • $\begingroup$ +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. $\endgroup$
    – halirutan
    Mar 16, 2012 at 1:25
  • $\begingroup$ Nice, I especially like the manipulate! $\endgroup$
    – tkott
    Mar 16, 2012 at 2:11
  • $\begingroup$ @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...) $\endgroup$
    – P. Fonseca
    Mar 16, 2012 at 6:56
  • 1
    $\begingroup$ 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. $\endgroup$
    – murray
    Mar 17, 2012 at 15:51
7
$\begingroup$

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

enter image description here

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

enter image description here

$\endgroup$
2
  • $\begingroup$ is there an advantage to using Inset and Prolog vs. Overlay or is this personal preference? $\endgroup$ Mar 17, 2012 at 4:25
  • 1
    $\begingroup$ 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. $\endgroup$ Mar 17, 2012 at 4:31
4
$\begingroup$

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:

Mathematica graphics

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

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Thanks!, it doesn't quite work as well as I expected, but oh well. $\endgroup$
    – tkott
    Mar 16, 2012 at 2:12

Your Answer

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

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