# Custom 3d histogram

so I wondered if there is a way to use histogram list such that it doesn't bin in quadrat mode, but given a set of 3D points, could bin over a tessellation of some regular tetrahedrons/hexagons/spheres?

• This might finally help someone. (It was originally written due to an embarrassing misunderstanding.) Feb 26, 2019 at 16:25
• Amazing! I'm going to see if I can make it work in 3D, thanks @Szabolcs
– MKF
Feb 26, 2019 at 16:27
• Can itgeneralise to 3D? and with the tally function, can we only make it tetrahedral, with colours defined by transparency instead?
– MKF
Feb 26, 2019 at 16:29
• You might consider SmoothKernelDistribution. It works in all dimensions.
– JimB
Feb 26, 2019 at 16:38
• Can you tile space with tetrahedra? I don't think it's possible. Feb 26, 2019 at 18:58

th = Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt/2, 0}, {1/2, Sqrt/6, Sqrt/3}}];
bins = N @ NestedSymmetricSubdivision[th, 3];
centers = RegionCentroid /@ bins;
nf = Nearest[centers -> "Index"];

SeedRandom
rp = RandomPoint[Cuboid[], 3000];
tF = FindGeometricTransform[th[], Tetrahedron[][]][];
transformed = tF /@ (Normalize[#, Total[#]/Max[#] &] & /@ rp);
Row[{Graphics3D[{Blue, Point@rp, Opacity[.05], Cuboid[]}, ImageSize -> 400],
Graphics3D[{Red, Point@transformed, Opacity[.05], th},
BoxRatios -> 1, ImageSize -> 400]}] groups = GatherBy[transformed, nf[#, 1] &];
tallies = {Rescale[Length /@ groups], bins[[nf[#[], 1]]] & /@ groups};
Show[Graphics3D[{FaceForm[], th,
Transpose[{FaceForm[Opacity[Rescale[#, {0, 1}, {0.05, .25}], Blue]]&/@#, #2}&@@tallies]},
Boxed -> True, BoxRatios -> 1],
ListPointPlot3D[groups, PlotStyle -> (ColorData[{"Rainbow", "Reversed"}]/@ tallies[])],
ImageSize -> Large] • Wow, your skills know no bounds, massive massive thanks for figuring these out!
– MKF
Mar 10, 2019 at 13:23
• Thank you @MKF for the kind words.
– kglr
Mar 10, 2019 at 13:24
• I feel I was little help that's all
– MKF
Mar 10, 2019 at 13:24
• In any case, truly amazing @kglr
– MKF
Mar 10, 2019 at 13:31
• @MKF, yes; thank you. Fixed now.
– kglr
Mar 10, 2019 at 14:14

This isn't an answer, just a response to the previous comment

SymmetricSubdivision[Tetrahedron[pl_], k_] /; 0 <= k < 2^Length[pl] :=
Module[{n = Length[pl] - 1, i0, bl, pos}, i0 = DigitCount[k, 2, 1];
bl = IntegerDigits[k, 2, n];
pos = FoldList[If[#2 == 0, #1 + {0, 1}, #1 + {1, 0}] &, {0, i0},
Reverse[bl]];
Tetrahedron@Map[Mean, Extract[pl, #] & /@ Map[{#} &, pos + 1, {2}]]]

NestedSymmetricSubdivision[Tetrahedron[pl_], level_Integer] /;
level == 0 := Tetrahedron[pl]
NestedSymmetricSubdivision[Tetrahedron[pl_], level_Integer] /;
level > 0 :=
Flatten[NestedSymmetricSubdivision[
SymmetricSubdivision[Tetrahedron[pl], #], level - 1] & /@
Range[0, 7]]

Graphics3D[
NestedSymmetricSubdivision[
Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt/2, 0}, {1/2, Sqrt[
3]/6, Sqrt/3}}], 3], BaseStyle -> Opacity, Boxed -> False] • So the question is the following now, is there a way to convert this into a mesh, and tally all the points inside each mini tetrahedron, so that each tetrahedron has different opacity based on the number of points inside each region?
– MKF
Feb 27, 2019 at 13:55
• My guess is yes using ListDensityPlot3D[HistogramList[pts, 10][], DataRange -> the region of the tetrahedron] but with the above converted into a mesh somehow
– MKF
Feb 27, 2019 at 13:56
• You can easily find out if a point is in a tetrahedron using RegionMember[Tetraherdon[{....}]][pointOfInterest]. This would be easy to repurpose for tallying the points in each tetrahedron, though it might be slow. Feb 27, 2019 at 16:26
• Taking your own code, look at Graphics3D /@ NestedSymmetricSubdivision[ Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt/2, 0}, {1/2, Sqrt/6, Sqrt/3}}], 1]. It's quite clear from simple visual inspection that the tetrahedra are not identical. We can verify that they have the same Volume, but not the same SurfaceArea or the same shape. Of course we can still use them for binning if we want to. Feb 28, 2019 at 14:49
• If you can determine a center for each cell (tetrahedron or other) such that the cell would be a Voronoi cell, then you can use the same approach as in the code I linked: use Nearest to determine which cell each binned point belongs to. Feb 28, 2019 at 14:50

So I have some random points that lie in the tetrahedron, ,

and also calculate the centres of the tetraminos using Mean.

I apply indices = First /@ nf /@ cloud as in @Szabolcs code and now want to bin the points in each tetramino bin.

Here is histogram of the indices to check things are happening I have tried

tally = Tally[indices];

ListDensityPlot3D[Join[cloud, List /@ Sort[tally][[All, 2]], 2],
ColorFunction -> (ColorData["BeachColors"][1 - #] &)]


To bin the points but to no avail.

As for @N.J.Evans response, I define RegionMemberFunctions as

Map[RegionMember, NestedSymmetricSubdivision[
Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt/2, 0}, {1/2, Sqrt[
3]/6, Sqrt/3}}], 3]];


But if I try to now tally/bin the points with

    Table[Map[regionmemberfunctions[[i]], cloud], {i, 1,
Length[NestedSymmetricSubdivision[
Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt/2, 0}, {1/2, Sqrt[
3]/6, Sqrt/3}}], 3]]}];


It takes forever... Any ideas greatly appreciated!

• I think perhaps binning over the tetraminos and using something like this is great mathematica.stackexchange.com/questions/17260/…
– MKF
Mar 3, 2019 at 12:05
• And maybe via Which or Count there could be some success
– MKF
Mar 3, 2019 at 13:47