11
$\begingroup$

I have two lists with the same x-values but different y-values. I have used ListPlot to plot and fill the space (line) between them; however, I would like the color of the fill to be representative of the difference in y-values.

I have lists of the form {{x1,y1},..}: a , b

The normalized difference (from 0 to 1) between the points: diff

ListPlot[{a,b}, Filling -> {1-> {{2}, Map[Hue, diff]}}]

I have tried other methods, but this one was the simplest to demonstrate my intent.

I have had thoughts about ColorFunction, but my attempts have been met with frought. The x-values are Real.

$\endgroup$
5
  • $\begingroup$ Welcome to Mathematica.se! In general, we encourage users to register as they can interact with the site more fully. In particular, you can upvote useful question and answers. $\endgroup$
    – rcollyer
    Oct 5, 2012 at 18:06
  • 3
    $\begingroup$ @rcollyer You're talking to a ghost :) $\endgroup$ Oct 5, 2012 at 18:13
  • $\begingroup$ @belisarius where's my proton pack?!? $\endgroup$
    – rcollyer
    Oct 5, 2012 at 18:26
  • $\begingroup$ @rcollyer: who ya gonna call? $\endgroup$ Oct 6, 2012 at 1:03
  • $\begingroup$ @J.M. I ain't afraid of no ghosts! :) $\endgroup$
    – rcollyer
    Oct 6, 2012 at 1:31

2 Answers 2

7
$\begingroup$
n = 10;
{a, b} = {RandomReal[1, n], RandomReal[{1, 2}, n]};
t = Transpose@{Range@n, Transpose@{a, b}};
m = Max[EuclideanDistance @@@ Transpose[{a, b}]];
Framed@Column[{
   Show[ListLinePlot[{a, b}, PlotStyle -> Dashed], 
        Graphics[{Thick, {ColorData["DarkRainbow"][EuclideanDistance @@ #[[2]]/m], 
                  Line[Outer[List, {#[[1]]}, #[[2]]]]} & /@ t}]], 
   DensityPlot[x, {x, 0, m}, {y, 0, m/10}, ColorFunction -> ColorData["DarkRainbow"], 
              AspectRatio -> Automatic, FrameTicks -> {{None, None}, {Automatic, None}}, 
              PlotLabel -> "Distance Color"]}]  

Mathematica graphics

Edit

Another way:

f[x_] := {Sin[x], Cos[20 x]};
cm = First@NMaximize[Abs@Differences@f[x], x];
colorIdx[n_] := First@Abs[Differences@f[n]]/cm;
Plot[{f[x][[1]], f[x][[2]]}, {x, 0, Pi}, Filling -> {1 -> {2}}, 
     ColorFunction -> Function[{x, y}, ColorData["DarkRainbow"][colorIdx[x]]], 
     FillingStyle -> Automatic, ColorFunctionScaling -> False]

Mathematica graphics

Edit

Going to 3D

n = 50;
a = N@Table[{Sin[t + Pi], Cos[t + Pi], (Sin[3 t] + 1/2)}, {t, Pi, 3 Pi, 2 Pi/n}];
b = N@Table[{Sin[t], Cos[t], (Sin[3 t] + 1/2)}, {t, 0, 2 Pi, 2 Pi/n}];
t = Transpose@{a, b};
m = Max[EuclideanDistance @@@ Transpose[{a, b}]];
Framed@Column[{Show[
 ParametricPlot3D[{{Sin[t+Pi],Cos[t+Pi],Sin[3 t]+1/2},{Sin@t,Cos@t,Sin[3 t]+1/2}},{t,0,2 Pi}],
 ParametricPlot3D[{{Sin[t], Cos[t], -1/2}, {Sin[t], Cos[t], 3/2}}, {t, 0, 2 Pi}],
 ParametricPlot3D[{r Sin[t], r Cos[t], -1/2}, {t, 0, 2 Pi}, {r, 0, 1}, 
                 Mesh -> False, PlotStyle -> Black],

 Graphics3D[{Thick, {ColorData["DarkRainbow"][EuclideanDistance @@ #/m], Line[#]} & /@ t}], 
            Boxed -> False, Axes -> False], 
 DensityPlot[x, {x, 0, m}, {y, 0, m/10}, 
    ColorFunction -> ColorData["DarkRainbow"], 
    AspectRatio -> Automatic, 
    FrameTicks -> {{None, None}, {Automatic, None}}, 
    PlotLabel -> "Distance Color"]}]

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ Is not it somehow possible to do it from with in ListPlot option specification? $\endgroup$ Oct 5, 2012 at 18:16
  • $\begingroup$ @PlatoManiac I guess not without manipulating the Plot's FullForm (which should be avoided if possible). But perhaps someone comes with an idea later. $\endgroup$ Oct 5, 2012 at 18:18
  • $\begingroup$ I tried to use ColorFunction to define a field that was a function of x, and that had values corresponding to the difference. $\endgroup$
    – Ghost
    Oct 5, 2012 at 19:44
3
$\begingroup$

UPDATE: My favorite: CandleStickChart -- easy, convenient and with a lot of cool options/features.

In particular, the last argument #6 of the color function can be used to exactly what the OP wants. All one needs is to transform the input data to a form that CandleStickChart accepts: that is, a list {{date},{prices}} for each data point. This is easily done using MapIndexed as in the example below:

CandlestickChart[MapIndexed[{#2, #1} &, Riffle[dt, dt] // Transpose],
  ChartElementFunction -> "ArrowCandlestick",
  ColorFunction -> Function[{date, open, high, low, close, trend}, Hue[trend]]]

enter image description here


Some test data:

ddd = RandomInteger[100, 10];
dt = {ddd,  ddd + (RandomChoice[RandomChoice[{-#, #}] & /@ Range[10, 25, 5]] & /@ Range[10])};

Post-processing ListPlot output to replace the Line primitive with appropriate directive/primitive combinations.

lstplt =ListPlot[dt,Filling -> {1 -> {2}},ImageSize->300,ColorFunctionScaling-> False];
{coords,lines} = {Cases[ lstplt,
  GraphicsComplex[crds:{x__},___] :> crds, {0, Infinity}][[1]],
 Cases[lstplt, ll : (Line[{_, _}] ..) :> ll, {0, Infinity}]};

Row[lstplt /. Line[{xx__}] :> {Thickness[.03], Opacity[.8], CapForm["Round"],
  #[Rescale[coords[[{xx}]][[2, 2]] - coords[[{xx}]][[1, 2]], 
      {Min@#, Max@#} &@(dt[[1]] -  dt[[2]]), {0.1, .9}]],
  Line[coords[[{xx}]]]} & /@ {Hue, ColorData["BrightBands"]}, Spacer[10]]

enter image description here

Using DiscretePlot and its options ExtentSize, ExtentElementFunction, and ExtentMarkers:

diff = Rescale[dt[[1]] - dt[[2]], {Min@#, Max@#} &@(dt[[1]] - dt[[2]]), {0.1, .9}];
g[{{xmin_, xmax_}, {ymin_, ymax_}}, ___] := 
    Rectangle[{xmin, ymin}, {xmax, ymax}, RoundingRadius -> Offset[10]];

 sh1 = Show[DiscretePlot[{dt[[1]][[k]], dt[[2]][[k]]}, {k, Range[10]},ImageSize -> 300,
   ExtentSize -> .5, Filling -> {1 -> {2}}, ColorFunctionScaling -> False,
   ColorFunction -> Function[{x, y}, ColorData["BrightBands"][diff[[Round[ x]]]]],
   ExtentElementFunction -> g],
 DiscretePlot[{dt[[1]][[k]], dt[[2]][[k]]}, {k, Range[10]}, Joined -> {True, True},
   PlotStyle -> Thick, Filling -> None, ImageSize -> 300]];

 sh2 = Show[DiscretePlot[{dt[[1]][[k]], dt[[2]][[k]]}, {k, Range[10]},ImageSize -> 300,
   ExtentElementFunction -> "ArrowRectangle", ExtentSize -> .5, 
   Filling -> {1 -> {2}}, ColorFunctionScaling -> False,
   ColorFunction -> Function[{x, y}, ColorData["BrightBands"][diff[[Round[ x]]]]]],
 DiscretePlot[{dt[[1]][[k]], dt[[2]][[k]]}, {k, Range[10]}, Joined -> {True, True},
   PlotStyle -> Thick, Filling -> None, ImageSize -> 300]];

 Row[{sh1, sh2}, Spacer[10]]

enter image description here

$\endgroup$
2
  • $\begingroup$ Awesome use of less well known charting functions, +1! Have you considered working something like this into a blog post (hint, hint!)? $\endgroup$
    – Verbeia
    Oct 7, 2012 at 1:05
  • $\begingroup$ Verbeia, thank you. My understanding of how these functions work is still too shallow and sparse to be able to put together a decent blog post (perhaps, as I continue exploring/experimenting, I may muster some courage :) $\endgroup$
    – kglr
    Oct 7, 2012 at 1:16

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.