2
$\begingroup$

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?

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

3 Answers 3

Reset to default
3
$\begingroup$ 
th = Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt[3]/2, 0}, {1/2, Sqrt[3]/6, Sqrt[6]/3}}]; bins = N @ NestedSymmetricSubdivision[th, 3]; centers = RegionCentroid /@ bins; nf = Nearest[centers -> "Index"]; SeedRandom[1] rp = RandomPoint[Cuboid[], 3000]; tF = FindGeometricTransform[th[[1]], Tetrahedron[][[1]]][[2]]; 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]}]

enter image description here

groups = GatherBy[transformed, nf[#, 1] &]; tallies = {Rescale[Length /@ groups], bins[[nf[#[[1]], 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[[1]])], ImageSize -> Large]

enter image description here

Improve this answer
$\endgroup$
10
  • $\begingroup$ Wow, your skills know no bounds, massive massive thanks for figuring these out! $\endgroup$ Commented Mar 10, 2019 at 13:23
  • $\begingroup$ Thank you @MKF for the kind words. $\endgroup$ Commented Mar 10, 2019 at 13:24
  • $\begingroup$ I feel I was little help that's all $\endgroup$ Commented Mar 10, 2019 at 13:24
  • 1
    $\begingroup$ In any case, truly amazing @kglr $\endgroup$ Commented Mar 10, 2019 at 13:31
  • 1
    $\begingroup$ @MKF, yes; thank you. Fixed now. $\endgroup$ Commented Mar 10, 2019 at 14:14
1
$\begingroup$

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[3]/2, 0}, {1/2, Sqrt[ 3]/6, Sqrt[6]/3}}], 3], BaseStyle -> Opacity[0], Boxed -> False]

The mesh I wish to histogram over

Improve this answer
$\endgroup$
13
  • $\begingroup$ 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? $\endgroup$ Commented Feb 27, 2019 at 13:55
  • $\begingroup$ My guess is yes using ListDensityPlot3D[HistogramList[pts, 10][[2]], DataRange -> the region of the tetrahedron] but with the above converted into a mesh somehow $\endgroup$ Commented Feb 27, 2019 at 13:56
  • 1
    $\begingroup$ 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. $\endgroup$ Commented Feb 27, 2019 at 16:26
  • 2
    $\begingroup$ Taking your own code, look at Graphics3D /@ NestedSymmetricSubdivision[ Tetrahedron[{{0, 0, 0}, {1, 0, 0}, {1/2, Sqrt[3]/2, 0}, {1/2, Sqrt[3]/6, Sqrt[6]/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. $\endgroup$ Commented Feb 28, 2019 at 14:49
  • 2
    $\begingroup$ 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. $\endgroup$ Commented Feb 28, 2019 at 14:50
0
$\begingroup$

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

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

Histogram

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[3]/2, 0}, {1/2, Sqrt[ 3]/6, Sqrt[6]/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[3]/2, 0}, {1/2, Sqrt[ 3]/6, Sqrt[6]/3}}], 3]]}];

It takes forever... Any ideas greatly appreciated!

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.