5
$\begingroup$

How can I add a mesh over the following 3D plot?

data = {{{6,0,97/1000},{6,1,19/100},{6,2,149/250},{6,3,109/1000},{6,4,1/125}},{{7,1,327/1000},{7,2,351/1000},{7,3,301/1000},{7,4,1/50},{7,5,1/1000}},{{8,0,3/100},{8,1,89/1000},{8,2,53/100},{8,3,253/1000},{8,4,97/1000},{8,5,1/1000}},{{9,1,133/1000},{9,2,271/1000},{9,3,227/500},{9,4,3/25},{9,5,11/500}},{{10,0,17/1000},{10,1,6/125},{10,2,8/25},{10,3,69/200},{10,4,6/25},{10,5,29/1000},{10,6,1/1000}},{{11,1,33/500},{11,2,23/125},{11,3,391/1000},{11,4,69/250},{11,5,81/1000},{11,6,1/500}},{{12,0,1/200},{12,1,23/1000},{12,2,181/1000},{12,3,309/1000},{12,4,333/1000},{12,5,119/1000},{12,6,3/100}},{{13,1,23/1000},{13,2,87/1000},{13,3,159/500},{13,4,43/125},{13,5,93/500},{13,6,39/1000},{13,7,3/1000}},{{14,0,3/1000},{14,1,3/500},{14,2,43/500},{14,3,26/125},{14,4,46/125},{14,5,237/1000},{14,6,39/500},{14,7,13/1000},{14,8,1/1000}},{{15,1,2/125},{15,2,11/200},{15,3,27/125},{15,4,151/500},{15,5,29/100},{15,6,101/1000},{15,7,19/1000},{15,8,1/1000}},{{16,1,3/1000},{16,2,11/250},{16,3,139/1000},{16,4,7/25},{16,5,61/200},{16,6,173/1000},{16,7,47/1000},{16,8,9/1000}},{{17,1,1/250},{17,2,4/125},{17,3,57/500},{17,4,241/1000},{17,5,173/500},{17,6,91/500},{17,7,69/1000},{17,8,3/250}},{{18,1,1/500},{18,2,1/50},{18,3,17/200},{18,4,1/5},{18,5,27/100},{18,6,283/1000},{18,7,111/1000},{18,8,7/250},{18,9,1/1000}},{{19,1,1/1000},{19,2,9/1000},{19,3,3/50},{19,4,33/200},{19,5,7/25},{19,6,69/250},{19,7,161/1000},{19,8,21/500},{19,9,3/500}},{{20,1,1/1000},{20,2,9/1000},{20,3,11/250},{20,4,139/1000},{20,5,241/1000},{20,6,36/125},{20,7,39/200},{20,8,17/250},{20,9,7/500},{20,10,1/1000}}};

Show[ListPointPlot3D@data, Graphics3D[Line@# & /@ data]]

enter image description here

ListPlot3D doesn't do it:

 With[{pts = (PadRight[#, Max[Length@# & /@ data], I] & /@ data /. 
 I -> {0, 0, 0})}, ListPlot3D@pts]

produces the rather ugly

enter image description here

but it is going in the right direction for what I am after. What is the best way of achieving this?

Note

The full code for generating the data is:

act[nn_, trials_] := With[{aa = Partition[RandomReal[{0, 1}, 2 nn], 2]},
With[{cc = ({aa[[#]], First@Nearest[DeleteCases[aa, aa[[#]]], aa[[#]]]} 
& /@ Range@nn)}, 
With[{dd = Table[Position[aa, cc[[p, 2]]][[1, 1]], {p, nn}]}, 
With[{ee = Complement[Range@nn, dd]}, Length@ee]]]] & /@ Range@trials

data= Table[With[{tt = 10^3}, With[{aa = act[nn, tt]}, 
With[{bb = Sort@DeleteDuplicates@aa},
Transpose@{ConstantArray[nn, Length@bb], bb, 
(Length@# & /@ Split@Sort@aa)/tt}]]], {nn, 6, 20}];
$\endgroup$
  • 1
    $\begingroup$ Show[ListPlot3D@Flatten[data, 1], Graphics3D[Line@# & /@ data]] Is this what you're looking for? If not can you clarify what it should look like? $\endgroup$ – N.J.Evans Oct 8 '15 at 14:18
  • $\begingroup$ @N.J.Evans great - thanks - please post as answer :) $\endgroup$ – martin Oct 8 '15 at 14:20
  • $\begingroup$ Looks like Alexei was already on it! $\endgroup$ – N.J.Evans Oct 8 '15 at 14:21
  • $\begingroup$ @N.J.Evans by about 2 seconds!! ;) $\endgroup$ – martin Oct 8 '15 at 14:21
5
$\begingroup$

What about this:

ListPlot3D[Flatten[data, 1], ColorFunction -> "LakeColors"]

??

It gives

enter image description here

Have fun!

| improve this answer | |
$\endgroup$
  • $\begingroup$ great - nice colour scheme too ;) $\endgroup$ – martin Oct 8 '15 at 14:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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