Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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...
share|improve this question
    
High dimensional data visualization is a very hot research topic nowadays. –  Silvia Apr 18 '13 at 20:27
add comment

2 Answers

up vote 8 down vote accepted

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]]]

varying options for the plot using the fourth dimension

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.

share|improve this answer
    
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
add comment

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, ""}}, {}}}]

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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