Can my color function be written more simply?
colors = {Red, Green, Blue, Orange, Cyan, Magenta, Yellow, RGBColor[0, 0.5, 1], Black};
clrRls = Sequence @@ Join @@ Thread[{Append[Tuples[{1, -1}, 3], _], colors}];
ListPointPlot3D[f3[1, 1, 1], PlotStyle -> [email protected], BoxRatios -> {1, 1, 1},
ColorFunctionScaling -> False,
ColorFunction -> (Function[{x, y, z}, Switch[Sign[{z, x, y}], ##] &@clrRls])]
or
clrRls2 = Flatten@Thread[{Append[And @@@ Tuples[{Greater[#, 0], Less[#, 0]} & /@
{z, x, y}], True], colors}];
ListPointPlot3D[f3[1, 1, 1], PlotStyle -> [email protected], BoxRatios -> {1, 1, 1},
ColorFunctionScaling -> False,
ColorFunction -> (Function[{x, y, z}, ##] &[Which @@ clrRls2])]
Update: Further alternatives:
Cycling through the colors based on the sign patterns of the coordinates:
positionRls = Thread[Append[Tuples[{1, -1}, 3], {_, _, _}] -> Range[9]];
ListPointPlot3D[f3[1, 1, 1], BoxRatios -> {1, 1, 1}, ColorFunctionScaling -> False,
PlotStyle -> PointSize[.02],
ColorFunction -> Function[{x, y, z},
With[{pos = Sign[{z, x, y}] /. positionRls}, colors[[pos]]]]]
Using PlotStyle
instead of ColorFunction
:
dispatch = Thread[Append[Tuples[{1, -1}, 3], {_, _, _}] -> colors];
ListPointPlot3D[{#} & /@ f3[1, 1, 1], BoxRatios -> {1, 1, 1},
PlotStyle -> Thread[{PointSize[.02], (Sign[RotateRight@#] & /@ f3[1, 1, 1] /.
dispatch)}]]
Specifying point colors during Sow
ing and use with PlotStyle
:
f4[w_, h_, z_, d_: 0.04] := Reap[Do[If[Abs[i]/w + Abs[j]/h + Abs[k]/z == 1,
Sow[{{{i, j, k}}, Sign[{k, i, j}] /. dispatch}]],
{i, -w, w, d}, {j, -h, h, d}, {k, -z, z, d}]][[2, 1]];
ListPointPlot3D[f4[1, 1, 1][[All, 1]],
PlotStyle -> (Directive[{PointSize[.02], #}] & /@ f4[1, 1, 1][[All, 2]]),
BoxRatios -> {1, 1, 1}]
or, with Graphics3D
instead of ListPointPlot3D
:
f5[w_, h_, z_, d_: 0.04] := Reap[Do[If[Abs[i]/w + Abs[j]/h + Abs[k]/z == 1,
Sow[{Sign[{k, i, j}] /. dispatch, Point@{i, j, k}}]],
{i, -w, w, d}, {j, -h, h, d}, {k, -z, z, d}]][[2, 1]];
Graphics3D[{PointSize[.02], f5[1, 1, 1]}, BoxRatios -> {1, 1, 1}, Axes -> True]
Another possible way of rewriting it:
cf = Block[{x, y, z},
Which @@ Flatten[{
Thread[{
And[x ~#~ 0, y ~#2~ 0, z ~#3~ 0] & @@@ Tuples[{Greater, Less}, 3],
{Red, Cyan, Green, Magenta, Blue, Yellow, Orange, RGBColor[0, 0.5, 1]}
}],
True, Black
}]
]
ListPointPlot3D[f3[1, 1, 1], PlotStyle -> [email protected], BoxRatios -> {1, 1, 1},
ColorFunctionScaling -> False, ColorFunction -> ({x, y, z} \[Function] Evaluate@cf)]
I think I have the colors around the wrong way, the Black
catch-all doesn't get used - but this is as simple as I can get it.
colors = Reverse@{Red, Green, Blue, Orange, Cyan,
Magenta, Yellow, RGBColor[0, 0.5, 1], Black}
ListPointPlot3D[f3[1, 1, 1], PlotStyle -> [email protected],
ColorFunction -> ({x, y, z} \[Function]
colors[[ FromDigits[UnitStep /@ {z, x, y}, 2] +1]]),
ColorFunctionScaling -> False, BoxRatios -> {1, 1, 1}]