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]]
ListPlot3D doesn't do it:
With[{pts = (PadRight[#, Max[Length@# & /@ data], I] & /@ data /.
I -> {0, 0, 0})}, ListPlot3D@pts]
produces the rather ugly
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}];
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$