ListDensityPlot3D not working with spherical data

Question

I'm trying to make a density plot of some data on a solid sphere, but I couldn't get ListDensityPlot3D to plot anything. I think there's something I'm missing, as I can't even get a simple plot to work with this function.

data = Flatten[Table[{r Sin[θ] Cos[ϕ], r Sin[θ] Sin[ϕ], r Cos[θ], Cos[θ]},
                     {r, 0, 1, 0.1}, {θ, 0, π, π/10}, {ϕ, 0, 2 π, 2 π/20}], 2];
cleandata = DeleteDuplicates[data];
Dimensions[cleandata]
ListPointPlot3D[cleandata[[;; , {1, 2, 3}]], BoxRatios -> {1, 1, 1}]
ListDensityPlot3D[cleandata]

The first command creates a list of {x,y,z,f} points. The second removes the duplicate points along the z axis. The third just shows the dimensions, demonstrating that they're correct. The fourth shows the locations of the points in 3D space. I expect the fifth to give me the density plot, but instead it shows nothing. This is the subject of my confusion.

What am I missing?

Edit: Fixed code to remove duplicates on z axis.

Answer 1

Looking into this some more, I think the problem might be that it's having difficulty doing interpolation between irregularly spaced (in Cartesian coordinates) points. I know higher order interpolations always yell at me if the points aren't nicely spaced. If this is the case, it's surprising that it doesn't throw an error message and simply fails. I'm not positive this is what's going on, but it seems like I get a reasonable result if I space the coordinates regularly in $x$, $y$, and $z$.

cubedata = 
  Flatten[
    Table[
      {x, y, z, 
        If[
          Sqrt[x^2 + y^2 + z^2] <= 1, 
          Cos[ToSphericalCoordinates[{x, y, z}][[2]]],
          0
        ]}, 
      {x, -1.19, 1.19, 0.08}, {y, -1.19, 1.19, 0.08}, {z, -1.19, 1.19, 0.08}
     ], 
   2];
ListDensityPlot3D[cubedata, PlotLegends -> Automatic]
ListDensityPlot3D[cubedata, PlotLegends -> Automatic, 
  OpacityFunction -> (Abs[#] &), OpacityFunctionScaling -> False]

And just out of curiousity, following this post What are the possible ways of visualizing a 4D function in Mathematica?, we can visualize the points with colours (where data is the same as the data you define above).

cleandata = DeleteDuplicatesBy[data, #[[1 ;; 3]] &];
Legended[
  Graphics3D[{
    AbsolutePointSize[8],
    Point[
      cleandata[[All, 1 ;; 3]], 
      VertexColors -> (ColorData["Rainbow"] /@ Rescale[cleandata[[All, 4]]])]
    },
    Axes -> True,
    AxesLabel -> {"x", "y", "z"}
  ],
  BarLegend[{"Rainbow", {-1, 1}}]
]