# ListDensityPlot of a data set in polar coordinates

I have this data set composed of a table of {r,f[r]}. I want to make a density plot of the data. It should look like the picture. The data is not normalized like the picture (some help with that would be appreciated) Can you help me?

Data avaliabe at: http://pastebin.com/nLn1c5ff

• Have a look ListDensityPlot
– user9660
Oct 7, 2016 at 17:04

data = Import["http://pastebin.com/raw/nLn1c5ff", "Table"];
fR = Interpolation[data];
DensityPlot[fR[Sqrt[x^2 + y^2]], {x, -5, 5}, {y, -5, 5},
ColorFunction -> GrayLevel]


I'm not sure how precisely you want to match your image. But it can be done by playing with ColorFunction

• I don't need to match the image, it is just a guide. But that solved my issue. Thanks! Oct 7, 2016 at 17:10
GraphicsRow[{ListPlot[data], ListPlot[data, PlotRange -> All]}, ImageSize -> 600]


{min, max} = MinMax[data[[All, 2]]]


{1.10589*10^-8, 11.7826}

scaled = Transpose @ {data[[All, 1]], (data[[All, 2]] - min)/(max - min)};

GraphicsRow[{ListPlot[scaled], ListPlot[scaled, PlotRange -> All]}, ImageSize -> 600]


Differently:

toplot = Flatten[#, 1] & @
Table[{scaled[[i, 1]] Cos[t], scaled[[i, 1]] Sin[t],
scaled[[i, 2]]}, {t, 0, 2 π, 0.1}, {i, 1, Length @ scaled, 5}];

ListDensityPlot[toplot, PlotRange -> {{-5, 5}, {-5, 5}, All},
ColorFunction -> GrayLevel, PlotLegends -> Automatic]


Or another way of visualisation:

f = Interpolation[scaled];

r = RevolutionPlot3D[f[t], {t, 0, 10}]


• Yeah, I thought about that, but in your approach there are less data points per $dx dy$ when $r$ is large. So I decided to go with interpolation of data in polar coordinates, so the DensityPlot will decide how accurately it has to sample it . Oct 7, 2016 at 17:19
• @BlacKow I took every fifth point from data because it took a long time to render the image. I think there is enough data to yield no perceivable difference. I wanted to use Interpolation like you did, but you were faster ;) Oct 7, 2016 at 17:29

Using your data

{rmin, rmax} = MinMax[data[[All, 1]]]

(*  {2.04082*10^-7, 10.}  *)

{fmin, fmax} = MinMax[data[[All, 2]]]

*  {1.10589*10^-8, 11.7826}  *)


Normalizing the function to be in the interval {0,1}

f = Interpolation[
{#[[1]], (#[[2]] - fmin)/(fmax - fmin)} & /@
data];

Plot[f[r], {r, rmin, rmax}, PlotRange -> All]


The first minimum (EDIT) occurs at

m = r /. FindRoot[f'[r] == 0, {r, 4}]

(*  3.83171  *)

DensityPlot[
f[Sqrt[x^2 + y^2]], {x, -m, m}, {y, -m, m},
PlotTheme -> "Monochrome",
PlotPoints -> 75,
PlotLegends -> Automatic]


• Shouldn't it be "the first minimum occurs" instead of "the first zero occurs"? Since you are solving for derivative = 0? Oct 7, 2016 at 20:52
• @BlacKow - corrected. Thanks. Oct 7, 2016 at 21:03