3
$\begingroup$

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

enter image description here

$\endgroup$
  • 2
    $\begingroup$ Have a look ListDensityPlot $\endgroup$ – user9660 Oct 7 '16 at 17:04
8
$\begingroup$
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]

enter image description here

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

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

enter image description here

{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]

enter image description here

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]

enter image description here


Or another way of visualisation:

f = Interpolation[scaled];

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

enter image description here

$\endgroup$
  • $\begingroup$ 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 . $\endgroup$ – BlacKow Oct 7 '16 at 17:19
  • $\begingroup$ @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 ;) $\endgroup$ – corey979 Oct 7 '16 at 17:29
4
$\begingroup$

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]

enter image description here

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]

enter image description here

$\endgroup$
  • $\begingroup$ Shouldn't it be "the first minimum occurs" instead of "the first zero occurs"? Since you are solving for derivative = 0? $\endgroup$ – BlacKow Oct 7 '16 at 20:52
  • $\begingroup$ @BlacKow - corrected. Thanks. $\endgroup$ – Bob Hanlon Oct 7 '16 at 21:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.