# ListLinePlot with slope-dependent color

I would like the line coloring in ListLinePlot to be Red if the slope is negative; i.e., yn<yn-1 and Blue if the slope is positive.

A similar topic was solved for the Plot function using the normal vector but here I would not like to use interpolation.

• If use interpolation, InterpolationOrder->1 + ColorFunction -> Function[{x,y}, Which[f'[x] < 0, Blue, f'[x] == 0, Red, True, Green]], ColorFunctionScaling -> False could help. (Put here just for reference.) Dec 4, 2022 at 20:48
• Thank. This is a way to use Interpolation without really to use it ! Dec 5, 2022 at 8:16

SeedRandom[1];
data = RandomFunction[RandomWalkProcess[0.5], {0, 20}] // Normal //
First;
data2 = Partition[data, 2, 1];
cols = If[Last@Last@# < Last@First@#, Red, Blue] & /@ data2;

ListLinePlot[data2, PlotStyle -> cols]


EDIT

Since I edited the question to include the word slope, here is a variant that uses three colors like the answer posted by @cvgmt.

SeedRandom[123];
data = Transpose[{Range[20],
Accumulate[RandomChoice[{-1, 0, 1}, 20]]}];
data2 = Partition[data, 2, 1];
cols = If[Last@Last@# == Last@First@#, Darker@Green,
If[Last@Last@# < Last@First@#, Red, Blue]] & /@ data2;
ListLinePlot[data2, PlotStyle -> cols]


Explanation of the Last@Last@...

After partitioning data in 2-tuples with an overlap of 1, each entry has two items. First@# would refer to the first point and Last@# would refer to the last (second in this case) point. The Last@First@# would refer to the y-coordinate in the first point entry or the part [[1,2]] and Last@Last@# would refer to the part [[2,2]] or the y-coordinate of the second entry.

• Thanks. This is what I was meaning. I still need to be confident with istruction like Last@Last@# < Last@First@#. Great! Dec 5, 2022 at 8:17
• Here we also deal with the case when y[n]==y[n-1].

• We use the Sign to get the sign of the slope and mapping to the colors by {1 -> Green, 0 -> Gray, -1 -> Red}.

Clear[data, line];
data = {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {5, 5}, {6,
5}, {7, 5}, {8, 7}, {9, 6}, {10, 5}, {11, 8}, {12, 8}, {13,
8}, {14, 4}, {15, 4}, {16, 3}, {17, 2}, {18, 1}, {19, 5}, {20,
5}, {21, 5}, {22, 7}, {23, 8}};
line[{a_,
b_}] := {Sign[(b[[2]] - a[[2]])/(b[[1]] - a[[1]])] /. {1 -> Blue,
0 -> Green, -1 -> Red}, Line[{a, b}]}
BlockMap[line, data, 2, 1] // Graphics


• Histogram
Clear[data, polys];
data = {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {5, 5}, {6, 5}, {7, 5}, {8,
7}, {9, 6}, {10, 5}, {11, 8}, {12, 8}, {13, 8}, {14, 4}, {15,
4}, {16, 3}, {17, 2}, {18, 1}, {19, 5}, {20, 5}, {21, 5}, {22,
7}, {23, 8}};
polys = Partition[data, 2,
1] /. {p_, q_} :> {EdgeForm[Directive[White, JoinForm["Round"]]],
Sign[q[[2]] - p[[2]]] /. {1 -> Blue, 0 -> Green, -1 -> Red},
Polygon[{p, q, Projection[q, {1, 0}], Projection[p, {1, 0}]}]};
Graphics[polys, Axes -> True, AxesOrigin -> {0, 0},
AspectRatio -> Automatic]