2
$\begingroup$

I am facing a problem in getting a smooth plot of following data.

DD := {{{0, 0}, 1}, {{0, 0.1}, 1}, {{0, 0.2}, 1}, {{0, 0.3}, 1}, {{0, 0.4}, 1}, {{0, 0.5}, 1}, {{0, 0.6}, 1}, {{0, 0.7}, 1}, {{0, 0.736}, 1}, {{0.2, 0.0}, 0.997978}, {{0.2, 0.1}, 0.99592}, {{0.2, 0.2}, 0.994118}, {{0.2, 0.3}, 0.99321}, {{0.2, 0.4}, 0.990521}, {{0.2, 0.5}, 0.990098}, {{0.2, 0.6}, 0.981427}, {{0.2, 0.684}, 0.954755}, {{0.3, 0}, 0.99357}, {{0.3, 0.3}, 0.985479}, {{0.3, 0.628105}, 0.927041}, {{0.4, 0}, 0.991344}, {{0.4, 0.1}, 0.988842}, {{0.4, 0.3}, 0.980593}, {{0.4, 0.4}, 0.972082}, {{0.4, 0.5573}, 0.900049}, {{0.5, 0.0}, 0.98288}, {{0.5, 0.1}, 0.979876}, {{0.5, 0.2}, 0.972208}, {{0.5, 0.3}, 0.964005}, {{0.5, 0.4}, 0.943466}, {{0.5, 0.465}, 0.914242}, {{0.6, 0}, 0.976438}, {{0.6, 0.1}, 0.967633}, {{0.6, 0.2}, 0.960438}, {{0.6, 0.38848}, 0.876153}, {{0.7, 0.0}, 0.96334}, {{0.7, 0.1}, 0.953086}, {{0.7, 0.2}, 0.935014}, {{0.7, 0.2952}, 0.874474}, {{0.8, 0}, 0.952486}, {{0.8, 0.1}, 0.933406}, {{0.8, 0.198}, 0.874677}, {{0.9, 0}, 0.928887}, {{0.9, 0.09983}, 0.866017}} f = Interpolation[DD, InterpolationOrder -> 16]; ContourPlot[Quiet[Check[f[a, g], Null]], {a, 0, 0.9}, {g, 0, 0.75}, PlotLegends -> Automatic, MaxRecursion -> 5]

I am getting a rough plot on using Mathematica 9. I am looking to get a smooth plot. enter image description here Any suggestions are welcome.

Improve this question
$\endgroup$
2
  • $\begingroup$ Did any of the answers satisfied your need? There are things to do after your question is answered. It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one. One weeks is enough wait. Participation is essential for the site, please do your part. $\endgroup$ Commented Jul 11, 2018 at 18:24
  • $\begingroup$ @rhermans. Yes, suggestions for this problem worked for me. Many thanks to all. $\endgroup$ Commented Jul 13, 2018 at 16:22

2 Answers 2

Reset to default
6
$\begingroup$

At least in version 11.3 when Interpolation is called there is the error

Interpolation::udeg: Interpolation on unstructured grids is currently only supported for InterpolationOrder->1 or InterpolationOrder->All. Order will be reduced to 1.

Using InterpolationOrder -> All and appropriate PlotRange fixes the plot:

DD = {{{0,0},1},{{0,0.1},1},{{0,0.2},1},{{0,0.3},1},{{0,0.4},1},{{0,0.5},1}, {{0,0.6},1},{{0,0.7},1},{{0,0.736},1},{{0.2,0.0},0.997978},{{0.2,0.1},0.99592}, {{0.2,0.2},0.994118},{{0.2,0.3},0.99321},{{0.2,0.4},0.990521},{{0.2,0.5},0.990098}, {{0.2,0.6},0.981427},{{0.2,0.684},0.954755},{{0.3,0},0.99357},{{0.3,0.3},0.985479}, {{0.3,0.628105},0.927041},{{0.4,0},0.991344},{{0.4,0.1},0.988842},{{0.4,0.3},0.980593}, {{0.4,0.4},0.972082},{{0.4,0.5573},0.900049},{{0.5,0.0},0.98288},{{0.5,0.1},0.979876}, {{0.5,0.2},0.972208},{{0.5,0.3},0.964005},{{0.5,0.4},0.943466},{{0.5,0.465},0.914242}, {{0.6,0},0.976438},{{0.6,0.1},0.967633},{{0.6,0.2},0.960438},{{0.6,0.38848},0.876153}, {{0.7,0.0},0.96334},{{0.7,0.1},0.953086},{{0.7,0.2},0.935014},{{0.7,0.2952},0.874474}, {{0.8,0},0.952486},{{0.8,0.1},0.933406},{{0.8,0.198},0.874677},{{0.9,0},0.928887}, {{0.9,0.09983},0.866017}}; f = Interpolation[DD, InterpolationOrder -> All]; ContourPlot[f[x, y], {x, 0, 0.9}, {y, 0, 0.75}, PlotLegends -> Automatic, PlotPoints -> 50, PlotRange -> {All, All, {-0.4, 1.4}}, Contours -> Range[-4/10, 12/10, 1/5]]

In V10 ConvexHullMesh can be used to specify the plot region (because your data supports every edge of its convex hull):

ContourPlot[f[x, y], {x, y} ∈ ConvexHullMesh[DD[[All, 1]]], PlotLegends -> Automatic, PlotPoints -> 50, PlotRange -> All]

Edit: In V9 you can use the order 1 interpolation as a region function:

fDom = Interpolation[DD, InterpolationOrder -> 1]; f = Interpolation[DD, InterpolationOrder -> All]; ContourPlot[If[Check[fDom[a, g], True] =!= True, f[a, g], Null], {a, 0, 0.9}, {g, 0, 0.75}, PlotLegends -> Automatic, MaxRecursion -> 1, PlotPoints -> 50, PlotRange -> All]

In 11.3 the output is practically the same as that of the ConvexHullMesh version.

Edit: Maybe using a fit is better:

fit[x_, y_] = Normal[LinearModelFit[Append @@@ DD, x^# y^#2 & @@@ Tuples[{0, 1, 2, 3, 4}, 2], {x, y}]]; fDom = Interpolation[DD, InterpolationOrder -> 1]; ContourPlot[If[Check[fDom[a, g], True] =!= True, fit[a, g], Null], {a, 0, 0.9}, {g, 0, 0.75}, PlotRange -> {All, All, {0.86, 1.02}}, PlotLegends -> Automatic, PlotPoints -> 50, MaxRecursion -> 1, Contours -> (Rescale[#, {Min[#], Max[#]}, {0.84, 1}] &[Range[20] // Sqrt])]

Improve this answer
$\endgroup$
3
  • $\begingroup$ Thanks for suggestions..Actually I am looking to get smoother version of plot that I show. I checked interpolation order is not changing the smoothness except interpolationorder->All. The plots that you are showing are not surving my purpose. Thanks again. $\endgroup$ Commented Jul 5, 2018 at 16:28
  • $\begingroup$ @Rahulkumarwalia I added another approach $\endgroup$ Commented Jul 5, 2018 at 17:05
  • $\begingroup$ Thanks. In fDom function why we can not have interpolation order higher than 1. $\endgroup$ Commented Jul 13, 2018 at 16:25
2
$\begingroup$

I am using Version 11.3, but I hope the code below would produce similar results for you in Version 9.

dd = Flatten /@ {{{0, 0}, 1}, {{0, 0.1}, 1}, {{0, 0.2}, 1}, {{0, 0.3}, 1}, {{0, 0.4}, 1}, {{0, 0.5}, 1}, {{0, 0.6}, 1}, {{0, 0.7}, 1}, {{0, 0.736}, 1}, {{0.2, 0.0}, 0.997978}, {{0.2, 0.1}, 0.99592}, {{0.2, 0.2}, 0.994118}, {{0.2, 0.3}, 0.99321}, {{0.2, 0.4}, 0.990521}, {{0.2, 0.5}, 0.990098}, {{0.2, 0.6}, 0.981427}, {{0.2, 0.684}, 0.954755}, {{0.3, 0}, 0.99357}, {{0.3, 0.3}, 0.985479}, {{0.3, 0.628105}, 0.927041}, {{0.4, 0}, 0.991344}, {{0.4, 0.1}, 0.988842}, {{0.4, 0.3}, 0.980593}, {{0.4, 0.4}, 0.972082}, {{0.4, 0.5573}, 0.900049}, {{0.5, 0.0}, 0.98288}, {{0.5, 0.1}, 0.979876}, {{0.5, 0.2}, 0.972208}, {{0.5, 0.3}, 0.964005}, {{0.5, 0.4}, 0.943466}, {{0.5, 0.465}, 0.914242}, {{0.6, 0}, 0.976438}, {{0.6, 0.1}, 0.967633}, {{0.6, 0.2}, 0.960438}, {{0.6, 0.38848}, 0.876153}, {{0.7, 0.0}, 0.96334}, {{0.7, 0.1}, 0.953086}, {{0.7, 0.2}, 0.935014}, {{0.7, 0.2952}, 0.874474}, {{0.8, 0}, 0.952486}, {{0.8, 0.1}, 0.933406}, {{0.8, 0.198}, 0.874677}, {{0.9, 0}, 0.928887}, {{0.9, 0.09983}, 0.866017}}; ListPointPlot3D[dd, PlotRange -> All]

enter image description here

At this point I try to device some function for ContourPlot's option RegionPlot. I am using Internal`ListMin from this discussion: "upper envelope of data". (I assume the function ListMin is also available in Version 9.)

upper = -Internal`ListMin[-Map[Most, dd]]; ListPlot[upper]

enter image description here

fb = Interpolation[upper, InterpolationOrder -> 2]; f = Interpolation[dd, InterpolationOrder -> All]; ContourPlot[f[x, y], {x, 0, 0.9}, {y, 0, 0.75}, PlotLegends -> Automatic, PlotPoints -> 120, PerformanceGoal -> "Speed", PlotRange -> All, RegionFunction -> Function[{x, y}, 0 <= y <= fb[x]]]

enter image description here

Improve this answer
$\endgroup$