# Mapping higher dimensions to color, opacity, point size, etc

I have a set of points of dimension >3, and I'd like to modify ListPointPlot3D so that the higher dimensions are mapped to different variables, such as color, opacity, point size, etc. so for example

a = Table[RandomVariate[NormalDistribution[3], 4], {5000}];
ListPointPlot3D[a] +some options...

-
High dimensional data visualization is a very hot research topic nowadays. – Silvia Apr 18 '13 at 20:27

Something like this?:

t1 = Table[RandomVariate[NormalDistribution[3], 4], {500}];
min = Min[t1[[;; , 4]]];
max = Max[t1[[;; , 4]]];
ps = {PointSize[1/30 (# - min)/(max - min)],
Hue[(# - min)/(max - min)], Opacity[(# - min)/(max - min)]} & /@t1[[;; , 4]];
Show[ListPointPlot3D[{t1[[;; , 1 ;; 3]][[#]]},PlotStyle -> {Evaluate[ps[[#]]]}] & /@ Range[Length[ps]]]


You can do it as a single plot (rather than a table) and it would be faster but this was the easiest way I found to do it.

-
Are you aware that there is a built-in function named Rescale[]? – J. M. Apr 18 '13 at 8:30
I wasn't, thank you. Normally I don't expect such simple functions to be available so it's nice when they are. – Jonathan Shock Apr 18 '13 at 8:44

Here is another example. This is a plotting routine that I used recently. It is very customized to my application, but gives you another idea how to visualize n-dim data. Each data point depends on three model parameters {n,M,$\chi$}. I encode the parameter values as symbol size, symbol shape and symbol color. (The parameter values take fixed values and do not change continously).

filledsymbols = {"\[FilledCircle]", "\[FilledSquare]",
"\[FilledDiamond]", "\[FilledRectangle]", "\[FilledDownTriangle]",
"\[FilledUpTriangle]", "\[FilledRightTriangle]"};
emptysymbols = {"\[RightTriangle]", "\[EmptyCircle]",
"\[EmptySquare]", "\[EmptyDiamond]", "\[EmptyRectangle]",
"\[EmptyDownTriangle]", "\[EmptyUpTriangle]"};
symbolcolors = {Black, Gray, Blue, Red, Green, Orange, Cyan};
symbolsizes = {9, 12, 17, 22, 25};
marker[nstring_, Mstring_, \[Chi]string_] := Module[{m1, m2, m3},
m1 = Switch[nstring,
"30", symbolsizes[[1]],
"40", symbolsizes[[2]],
"50", symbolsizes[[3]],
"60", symbolsizes[[4]],
"70", symbolsizes[[5]]
];
m2 = Switch[Mstring,
"-30", filledsymbols[[1]],
"-20", filledsymbols[[2]],
"-10", filledsymbols[[3]],
"00",  filledsymbols[[4]],
"10",  filledsymbols[[5]],
"20",  filledsymbols[[6]],
"30",  filledsymbols[[7]]
];
{m2, m1}]
style[\[Chi]string_] := Module[{m1, m2, m3},
m3 = Switch[\[Chi]string,
"00", symbolcolors[[1]],
"10", symbolcolors[[2]],
"20", symbolcolors[[3]],
"30", symbolcolors[[4]],
"40", symbolcolors[[5]],
"50", symbolcolors[[6]],
"60", symbolcolors[[7]]
];
{m3}]


And here the plotting function.

Options[generalRatioPlot] = {ShowLegend -> True};
generalRatioPlot::wlen = "Data and parameter array have different length.";
generalRatioPlot[data_, parameter_, opts : OptionsPattern[]] :=
Module[{plt, legendAll, showleg},
showleg = ShowLegend /. {opts} /. Options[generalRatioPlot];
If[Length[parameter] =!= Length[data],Message[generalRatioPlot::wlen]; Abort[]];
legendAll = Flatten[{
Table[{Item[Style["\[FilledSquare]", Evaluate@symbolsizes[[i]]],
Alignment -> Left],
Item[Style[{"n=\!$$\*SuperscriptBox[\(10$$, $$3$$]\)",
"n=\!$$\*SuperscriptBox[\(10$$, $$4$$]\)",
"n=\!$$\*SuperscriptBox[\(10$$, $$5$$]\)",
"n=\!$$\*SuperscriptBox[\(10$$, $$6$$]\)",
"n=\!$$\*SuperscriptBox[\(10$$, $$7$$]\)"}[[i]],
FontFamily -> "Times"], Alignment -> Left]}, {i, 1, 5}],
Table[{emptysymbols[[i]],
Item[Style[{"M=0.001", "M=0.01", "M=0.1", "M=1", "M=10",
"M=100", "M=1000"}[[i]], FontFamily -> "Times"],
Alignment -> Left]}, {i, 1, 7}],
Table[{Style["\[FilledSquare]", symbolcolors[[i]]],
Item[Style[{"\[Chi]=1", "\[Chi]=10",
"\[Chi]=\!$$\*SuperscriptBox[\(10$$, $$2$$]\)",
"\[Chi]=\!$$\*SuperscriptBox[\(10$$, $$3$$]\)",
"\[Chi]=\!$$\*SuperscriptBox[\(10$$, $$4$$]\)",
"\[Chi]=\!$$\*SuperscriptBox[\(10$$, $$5$$]\)",
"\[Chi]=\!$$\*SuperscriptBox[\(10$$, $$6$$]\)"}[[i]],
FontFamily -> "Times"], Alignment -> Left]}, {i, 1, 7}]
}, 1];
plt = ListLogLogPlot[Partition[data, 1],
Evaluate[FilterRules[{opts}, Options[ListLogLogPlot]]],
PlotMarkers -> marker /@ parameter[[All, 1 ;; 2]],
PlotStyle -> style /@ parameter[[All, 3]], Frame -> True];
If[showleg, Graphics[{
Inset[Framed[Grid[legendAll], FrameStyle -> AbsoluteThickness[0.5]],
Offset[{0, 0}, {1, 1}], {Right, Top}],
Inset[Show[plt], Offset[{0, 4}, {-1, 1}], {Left, Top}, {1.7, 1.95}]},
PlotRange -> 1., AspectRatio -> (1/GoldenRatio*0.88), ImageSize -> 600],
Show[plt, AspectRatio -> (1/GoldenRatio*0.88), ImageSize -> 600]]
];


And here a brief example:

data = Uncompress["1:eJxTTMoPSjNiYGAoZgESPpnFJWlMyLyiP0F72T+6tzoXdd4sWqOwPNgBTT5xIk//7FvCzkUBMacTpmm1oMuvTVm2bsuEdc5Fm2cubz+jFYgu3xM3oXWnQZNz0Web2acE68LQ5Ss9bjRFBU92Lsp/UbBm1aoAdPnOlr+JxXEBzkXc2p3L3moWocv7RfmGm50Buk/uvZek2vdmdPnak6zlPIeB9h80vFqi/gLD/qsB1XdCNOY4F317r36ucT2G+2ckf7Bl7tzkXPTM5NnLjj0Y7uuesEV05axFzkWezv9P5O3CkF+3ck3E/LU+zkWrwABDfp+OwaXfZeudi2pUL+zUiMGwv003OpLhzgLnIu85bQd+vsDQf/OEv83T653ORVdit8zm1glCl3cLeLRx4vIC5yLfhJ7VWOw/y8B4VmjRYueiWR5nmr02YMg7bnxwzevFLueiXZzKN5ZdwpBfvTPlaApTo3NRkz//sv6sGHR5DsmpD6yiQpyLjBgObf8cmYAuP9G2x7yxf4lz0bT8S1bpqzHMj9kdIR8xYYJzEWON24olUhjhc2nXvht/a7c6F708ejw48SeGfrFdi2fXLAKGf8gHW7a1mP4XjjXLt24Fho/Q2eRNepj2e92UkCuaV+tctCJqwdMYcwz7jXrb7zgJ7gSaf6Az6sZ5TPt/ZZTZPgDG3+ILrgt4hDH05/oH12SD0n/6xiPY0sfhuSzTt8gB0weDoVnU7fMY+g+I7lIWFtrtXBS4rrAqKRZDPrY42zpicr1z0SXhpc3HJUPR5S1ub1hwPgBov/jM5KzVmPY/WMawMlxD2rnoZmLNzaCMTHT5Qv07H/xuzweGP+OP5zt3YNjPvf/WHZspYc5F+zxaL6+7Ho8ufzTdflqrwkHnImc/qzXCtzDs79IvyVN/GudcpLjqJLbwqdryQ3D1FWD41lh7LBc5jmF/gOX6+17RwPKJaWvYT3V/DHmph9J/X/FtcC4qWxwrYbwDw/ym1UsamFI2A9O/f/+zj2sx5C//Snt2oxtYPhmEvVXY/70QXZ6tJTO39vZMYP78GzDx+yoM+3dZ/p+wa3Ozc9GtTwHGPB4Y5W/xxodKJhJA992Ji+r66YChf7PjzTkhK4D5U+bn4ZmvMfMnQ9Lqw8JTgOX74iTfMLWNGOY73nrx82INMH9+1Im2UwvDyJ9ejvc/zru90blIktn00FXpQAcA7XIlSA=="];
pars = Uncompress["1:eJyNVcsOwjAMm4Af4QOQsjZtf4IT+wMOkzhxGP8vxjSkenLTXNY9rMSx3e76fD/mMAzDclkv99fymc/103Rab7JMv5e3UbbHIBzzW3aIMEj5f9uWxCAJICODRGhkVQkGlwyNKASrUC4FIMogCnRzo9EmbzBGijsmGnXQAovNPnY0ZhoNSMQ8UMxhKEq49LVRl5U1Gys0FhnMFa1y6OQxqsWmy1hRv1b8uhrj5HTrKtJpZbSqRh1XgND4JcdQ6hC5CFrW94oyzv0dnl3BqYdydLIgYsiXHYdABGkcXraO6rqThw2NFhpleSnug836/Vg/jnQQ+Avpbu+P"];

generalRatioPlot[data, pars,
ShowLegend -> True,
PlotRange -> {{1 10^17, 3 10^18}, {65, 80}},
FrameTicks -> {{{50, 60, 65, 70, 75, 80, 90, 100, 110}, {}},
{{{10^17,"\!$$\*SuperscriptBox[\(10$$, $$17$$]\)"},
{10^18,"\!$$\*SuperscriptBox[\(10$$, $$18$$]\)"},
{2 10^17, ""}, {2 10^18, ""}, {3 10^17, ""},
{3 10^18, ""}, {4 10^17, ""},
{5 10^17, "5\[Cross]\!$$\*SuperscriptBox[\(10$$, $$17$$]\)"},
{6 10^17, ""}, {7 10^17, ""},
{8 10^17, ""}, {9 10^17, ""}}, {}}}]


-