4
$\begingroup$

I am trying to create horizon plots in Mathematica similar to what is described here:

http://timelyportfolio.blogspot.com/2012/08/more-on-horizon-charts.html

Any suggestions how to approach this?

Mathematica graphics

$\endgroup$
4
  • 2
    $\begingroup$ Have you tried anything? $\endgroup$ Aug 18, 2012 at 21:30
  • 1
    $\begingroup$ Welcome to Mathematica.SE, VanFalk! Please consider registering your account so that any upvotes you get on this question are added to those you might get on future questions and answers. That way, over time you will be able to do more on the site (post graphics, edit things, etc). $\endgroup$
    – Verbeia
    Aug 18, 2012 at 21:32
  • $\begingroup$ Please accept the following suggestion: When posting a question be prepared to remain online at least for an hour, checking comments and answers. If you disappear just after submitting your question, your chances to get good answers drop considerably. This time you were lucky! Verbeia was in a good mood. $\endgroup$ Aug 19, 2012 at 4:59
  • $\begingroup$ I think you should illustrate some of it in your question. When that link dies (when, not if) your question becomes unanswerable. $\endgroup$
    – stevenvh
    Aug 19, 2012 at 11:56

3 Answers 3

6
$\begingroup$

I am not going to give you the whole code for this, rather some pointers on how to get there.

To get a single horizon plot, you need to apply Filling appropriately. Unfortunately, getting different filling styles on different lines in a plot is not actually well documented. Here is some test data and a plot that does it correctly.

aapl = FinancialData["AAPL", {2007, 1}];
ibm = FinancialData["IBM", {2007, 1}];
msft = FinancialData["MSFT", {2007, 1}];    
aapl1 = {#1, #2 - aapl[[1, 2]]} & @@@ aapl;    
ibm1 = {#1, #2 - ibm[[1, 2]]} & @@@ ibm;    
msft1 = {#1, #2 - msft[[1, 2]]} & @@@ msft;

DateListPlot[{msft1, ibm1}, Joined -> True, 
  Filling -> {1 -> {Bottom, Directive[Blue, Opacity[0.2]]}, 
  2 -> {Bottom, Directive[Red, Opacity[0.2]]}}, PlotStyle -> None, 
  PlotRangePadding -> 0, GridLines -> None, 
  FrameTicks -> {{Automatic, None}, {Automatic, None}}, AspectRatio -> 0.2]

enter image description here

A Grid full of plots is easy to code up, but to create a function that takes a grid of plots and formats them automatically according to their position in the grid (e.g. hiding ImagePadding so x-axes are hidden for all but the bottom panel), you may find my answer to a question of my own useful.

My suggestion is that you create a horizonPlotGrid master function that takes a list of data, and Maps an auxiliary function horizonPlotPanel to each one.

The horizonPlotPanel function would look something like this:

 horizonplot[data : {{_List, _?NumericQ} ..}] := 
 With[{neg = {#1, If[Negative[#2], -#2, 0]} & @@@ data, 
   pos = {#1, If[Positive[#2], #2, 0]} & @@@ data}, 
  DateListPlot[{pos, neg}, Joined -> True, 
   Filling -> {1 -> {Bottom, Directive[Blue, Opacity[0.2]]}, 
     2 -> {Bottom, Directive[Red, Opacity[0.2]]}}, PlotStyle -> None, 
   PlotRangePadding -> 0, GridLines -> None, 
   FrameTicks -> {{Automatic, None}, {Automatic, None}}, 
   AspectRatio -> 0.2]]

You could also add the ability to add custom options using OptionsPattern. See this question for more information.

Things to notice about this function:

  1. The way I've used pattern matching {{_List, _?NumericQ} ..} in the function defintion to indicate that it's dated data (time series)

  2. The use of With to define local constants, in this case the positive and the negative data as separate series. (There might be even better ways to do this, but this ensures that each series goes back to zero where the other series is operative.)

  3. The custom Filling as shown in the other example.

To get the formatting you require, with horizontal bands as filling, I'd suggest adapting this existing answer.

$\endgroup$
4
$\begingroup$

A very "manual" procedure, just to help you get started:

ge = MovingAverage[FinancialData["GE", {2000}][[All, 2]], 100];
ge = ge - Min@ge - (Max@ge - Min@ge)/2;
s = Max@ge/2;
Attributes[f] = HoldAll;
f[x_, y_] := AppendTo[x, y];
Array[(l[#] = {}) &, 6];
(*for simplicity,we will work with all values>0*)
If[# > 0, f[l[1], #]; f[l[2], 0],     f[l[1], 0]; f[l[2], #]] & /@  ge;
If[# > s, f[l[3], s]; f[l[4], # - s], f[l[3], #]; f[l[4], 0]] & /@  l[1];
If[# > s, f[l[5], s]; f[l[6], # - s], f[l[5], #]; f[l[6], 0]] & /@ -l[2];

ListLinePlot[{l[3], l[4], l[5], l[6]}, 
 PlotStyle -> None, 
 Filling -> {
   1 -> {Axis, Directive[Blue, Opacity[0.2]]}, 
   2 -> {Axis, Directive[Blue, Opacity[0.4]]}, 
   3 -> {Axis, Directive[Red,  Opacity[0.2]]}, 
   4 -> {Axis, Directive[Red,  Opacity[0.4]]}}, AspectRatio -> 1/4]

Mathematica graphics

Please note: The procedure above is manual on purpose, you will have to generalize it. Teaching to fish.

A Sin[x] horizon Plot:

Mathematica graphics

$\endgroup$
1
$\begingroup$
Plot[Sin[Exp[ Sin[x]]] - .6, {x, 0, 4 Pi}, Filling -> Axis, 
 FillingStyle -> {LightRed, LightBlue}]

enter image description here

Plot[Sin[Exp[ Sin[x]]] - .6, {x, 0, 4 Pi}, 
 ColorFunction -> Function[{x, y}, Hue[y]], Filling -> Axis, 
 FillingStyle -> Automatic]

enter image description here

Show[Plot[Sin[Exp[ Sin[x]]] - .6, {x, 0, 4 Pi}, 
  ColorFunction -> Function[{x, y}, Hue[y]], Filling -> Axis, 
  FillingStyle -> Automatic], 
 Plot[(Sin[Exp[ Sin[x]]] - .6)/3, {x, 0, 4 Pi}, 
  ColorFunction -> Function[{x, y}, Hue[y/2]], Filling -> Axis, 
  FillingStyle -> Automatic]]

enter image description here

Show[Plot[Sin[Exp[ Sin[x]]] - .6, {x, 0, 4 Pi}, Filling -> Axis, 
  FillingStyle -> {LightRed, LightBlue}], 
 Plot[(Sin[Exp[ Sin[x]]] - .6)/3, {x, 0, 4 Pi}, Filling -> Axis, 
  FillingStyle -> {Red, Blue}]]

enter image description here

Plot[{Sin[Exp[ Sin[x]]] - .6, (Sin[Exp[ Sin[x]]] - .6)/3}, {x, 0, 
  4 Pi}, ColorFunction -> Function[{x, y}, Blend[{Red, Blue}, y]], 
 Filling -> Axis, FillingStyle -> Automatic]

enter image description here

data = Accumulate[RandomInteger[{-10, 10}, 100]];
avg = MovingAverage[data, 10];
DateListPlot[{data, Legended[avg, "moving average"]}, {{2013, 1, 1}, 
  Automatic, "Day"}, Joined -> True, 
 Filling -> {{1 -> {Axis, {Red, Blue}}}, {2 -> {Axis, {LightRed, 
       LightBlue}}}}]

enter image description here

Show[Plot[
  Piecewise[{{Exp[-(x + .45)^2/.005]/4, -5 < 
      x < -.3}, {-Exp[-(x + 0.15)^2/.005]/4, -.3 < x < 
      0}, {Exp[-(x - 0.15)^2/.005], 
     0 < x < 0.3}, {-Exp[-(x - 0.5)^2/.005], 
     0.35 < x < 0.65}}], {x, -1, 1}, Filling -> Axis, 
  FillingStyle -> {LightRed, LightBlue}, PlotRange -> All], 
 Plot[Piecewise[{{Exp[-(x + .45)^2/.005]/4, -5 < 
       x < -.3}, {-Exp[-(x + 0.15)^2/.005]/4, -.3 < x < 
       0}, {Exp[-(x - 0.15)^2/.005], 
      0 < x < 0.3}, {-Exp[-(x - 0.5)^2/.005], 0.35 < x < 0.65}}]/
   3, {x, -1, 1}, Filling -> Axis, FillingStyle -> {Red, Blue}, 
  PlotRange -> All]]

enter image description here

Plot[Sin[x], {x, 0, 2 Pi}, Filling -> 0.3, 
 FillingStyle -> {Red, Blue}]

enter image description here

Plot[{Piecewise[{{Abs@Sin[x], 0 < x < \[Pi]}}], 
  Piecewise[{{Abs@Sin[x], \[Pi] < x < 2 \[Pi]}}]}, {x, 0, 2 Pi}, 
 Filling -> Axis, FillingStyle -> {{1 -> Red}, {2 -> Blue}}]

enter image description here

And other combinations.

$\endgroup$

Your Answer

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

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