2
$\begingroup$

I need to plot a 2-dimensions function with density plot:

function define:

FTn[x_, y_, j_, pt_] := Fit[pt, Catenate[Table[Table[x^n y^(k - n), {n, 0, k}], {k, 0, j}]], {x, y}];

RFT[x_, y_, n_, pt_] := Module[{pl, RF, RFf},
   pl = FTn[a, b, n, pt];
   RF[s_, t_] := pl /. {a -> s, b -> t};
   RF[x, y]
   ];

pt={{3., 0., 2922.8}, {70., 0., 2917.48}, {28., 28., 2941.44}, {0., 70., 
  2942.56}, {-28., 28., 2917.72}, {-70., 0., 2927.08}, {-28., -28., 
  2936.56}, {0., -70., 2902.32}, {28., -28., 2919.12}, {102., 0., 
  2961.32}, {57., 72., 2972.48}, {0., 102., 2972.16}, {-57., 72., 
  2957.04}, {-102., 0., 2974.72}, {-57., -72., 2954.56}, {0., -102., 
  2966.2}, {57., -72., 2932.16}, {127., 0., 3134.8}, {102., 42., 
  2986.4}, {90., 90., 3138.88}, {42., 102., 2992.76}, {0., 127., 
  3132.8}, {-42., 102., 3005.48}, {-90., 90., 3126.88}, {-102., 42., 
  2996.12}, {-127., 0., 3122.8}, {-102., -42., 2988.12}, {-90., -90., 
  3110.96}, {-42., -102., 2994.12}, {0., -127., 3120.88}, {42., -102.,
   2985.48}, {90., -90., 3128.64}, {102., -42., 2996.24}, {147., 0., 
  4105.28}, {129., 54., 3463.08}, {104., 104., 4107.2}, {54., 129., 
  3467.84}, {0., 147., 4077.72}, {-54., 129., 3467.4}, {-104., 104., 
  4106.84}, {-129., 54., 3470.44}, {-147., 0., 4084.72}, {-129., -54.,
   3466.56}, {-104., -104., 4116.4}, {-54., -129., 
  3475.64}, {0., -147., 4113.2}, {54., -129., 3481.88}, {104., -104., 
  4150.4}, {129., -54., 3463.08}}

And also using the density plot function like this:

DensityPlot[RFT[x, y, 12, pt], {x, -#3, #3}, {y, -#3, #3},
   PlotLegends -> 
    BarLegend[{ColorData[{"Rainbow", {#1, #2}}], {#1, #2}}, 
     LabelStyle -> Directive[Black, FontSize -> 15, Bold], 
     LegendMarkerSize -> 300],
   PlotRange -> {{-#3, #3}, {-#3, #3}},
   ColorFunction -> ColorData[{"Rainbow", {#1, #2}}],
   PlotRange -> Full,
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 150^2],
   BoundaryStyle -> Red,
   ColorFunctionScaling -> False,
   FrameLabel -> {"HF-FTP(%)", "LF-FTP(%)"},
   FrameStyle -> Directive[Bold, 10, Black],
   PlotLabel -> 
    Style["function", 28, Bold,
      Black],
   ImageSize -> 350
   ] &[2600, 4500, 150]

But the output result is not the circle region:

enter image description here How can I fixed the code to plot a circle region?

$\endgroup$
  • $\begingroup$ Did you try to increase PlotPoints? $\endgroup$ – Rom38 Jun 19 '17 at 9:41
  • $\begingroup$ I have tried to use the PlotPoints->100, but its still got the same result... $\endgroup$ – 400000000 Jun 19 '17 at 10:18
  • $\begingroup$ What is ERa[5]? Maybe you mean pt? $\endgroup$ – TeM Jun 19 '17 at 13:01
  • 1
    $\begingroup$ Try using the plot range PlotRange->{{-#3,#3},{-#3,#3},All}. I'm guessing that some clipping is going on near the edges of the circle where things seem to be changing very fast. You can also check this by adding ClippingStyle->Cyan and seeing if a cyan ring fills the circle appropriately out near the edges. Your region function looks good. $\endgroup$ – N.J.Evans Jun 19 '17 at 13:09
  • $\begingroup$ PlotRange->{{-#3,#3},{-#3,#3},All} is very useful and solved my problem, thanks. $\endgroup$ – 400000000 Jun 20 '17 at 1:15
1
$\begingroup$

I think the output is in fact a circular region, but your function "dies out" before you hit the edge of the circle. Drawing a circle around the region...

{DensityPlot[RFT[x, y, 12, pt], {x, -#3, #3}, {y, -#3, #3}, 
 PlotLegends -> 
  BarLegend[{ColorData[{"Rainbow", {#1, #2}}], {#1, #2}}, 
   LabelStyle -> Directive[Black, FontSize -> 15, Bold], 
   LegendMarkerSize -> 300], PlotRange -> {{-#3, #3}, {-#3, #3}}, 
 ColorFunction -> ColorData[{"Rainbow", {#1, #2}}], 
 PlotRange -> Full, 
 RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 150^2], 
 BoundaryStyle -> Red, ColorFunctionScaling -> False, 
 FrameLabel -> {"HF-FTP(%)", "LF-FTP(%)"}, 
 FrameStyle -> Directive[Bold, 10, Black], 
 PlotLabel -> Style["function", 28, Bold, Black], 
 ImageSize -> 350] &[2600, 4500, 150],Graphics[Circle[{0, 0}, 150]]}//Show

enter image description here

If you change the input to the DensityPlot a little (and I have no idea what this means to change it) then it looks nice. Changed parameter highlighted.

 DensityPlot[RFT[x, y, **6**, pt], etc...

enter image description here

Edit...

Fiddled with this a little more (interesting problem) and I think you are overfitting your pt data with a 12th order polynomial. Unless you have a physics-based reason to use that order, a reduced order would be better. The 6th order fit I used above is better. Just playing around, here is a ContourPlot of the 12th order fit with the boundaries extended outward. Note lack of symmetry, although I believe your points being fitted is symmetric.

enter image description here

|improve this answer|||||
$\endgroup$
  • $\begingroup$ I know RFT[x, y, 6, pt] can plot a circle graphic, but it's not precision... $\endgroup$ – 400000000 Jun 20 '17 at 1:18
0
$\begingroup$

one way to do this is to manually sample. This is a bit slow but gives you full control:

r = 150;
n = 100; (* resoluiton control *)
z = {{##}, 
    RFT[##, 12, pt]} & @@@ ((Position[DiskMatrix[n], 1] - n - 1) r/n);
range = MinMax@z[[All, 2]];
g = Graphics[{{ColorData[
         "Rainbow"][(#[[2]] - range[[1]])/(range[[2]] - range[[1]])],
       Rectangle[#[[1]] - r/n/2 {1, 1}, #[[1]] + r/n/2 {1, 1}]} & /@ 
     z, {Red, Thickness[1/n/4], Circle[{0, 0}, r + r/n/2]}}];

Show[g, Axes -> True, AxesOrigin -> {-175, -175}]

enter image description here

just to see whats happening at the edges:

ListPlot3D[Flatten /@ z, PlotRange -> All, ColorFunction -> "Rainbow"]

enter image description here

|improve this answer|||||
$\endgroup$

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.