# Extract region analytic expression from an image

I need to extract the bounds of the yellow and green regions in the picture at the end of the post. I need only to reproduce these regions on mathematica. I tried with the algorithm described here Recovering data points from an image but I get a strange result.

First, I extract some points to define the transformation which map the points of the image to the point of the plot

{x2, x1, y1, y2} = {{585.0590211326179,
54.42786889217291}, {272.0827458675517,
54.633881634729505}, {108.28544780639066,
442.48720495490045}, {108.04509960674113, 637.3237562279448}};


and then

trans = FindGeometricTransform[{{10^-4, 4}, {10^-4, 2}, {1.5,
10^-2}, {1.5, 10^-3}}, {x2, x1, y1, y2}][];


I check if the transformation works well

In:= trans@{x2, x1, y1, y2}

Out= {{0.0001, 4.}, {0.0001, 2.}, {1.5, 0.01}, {1.5, 0.001}}


and then

data = Round[ImageData[img], 1];
col = DeleteDuplicates[Flatten[Round[ImageData[img], 1], 1]];
Graphics[{RGBColor[#], Disk[]}, ImageSize -> Tiny] & /@ col I want to extract the 6th color, then

binImage = Image@Replace[data, {col[] -> 1, _ :> 0}, {2}];
curve = ImageApply[{0, 0, 0} &, binImage, Masking -> ColorNegate[Binarize[GaussianFilter[binImage, 5]]]];
curvLoc = (Reverse /@
Position[ImageData[curve, DataReversed -> True], {1., 1., 1.}]);
Show[ListPlot[trans@curvLoc, PlotRange -> All]]


Then the result is wrong and moreover I need just to extract the frontier of these regions, I don't need the internal points

Any help? Your graph has interesting feature: the regions of interest are antialiased from the bottom and the top only:

i = RemoveAlphaChannel@Import@"https://i.stack.imgur.com/4RfFP.png";
i2 = ColorReplace[i, {Green -> White, Black -> White, Yellow -> White}] Thanks to this feature the extraction of the boundaries becomes quite simple:

yellowBoundaries =
Select[ImageValuePositions[i2, RGBColor[1, 1, 0.5], .2],
RegionMember[Rectangle[{150, 200}, {1030, 600}]]];
greenBoundaries = ImageValuePositions[i2, RGBColor[.7, 1, 0], .2];
Graphics[{Green, Point@greenBoundaries, Yellow, Point@yellowBoundaries}] Separating the lines:

yellowLines = Sort /@ FindClusters[yellowBoundaries, 2, Method -> "Agglomerate"];
greenLines = Sort /@ FindClusters[greenBoundaries, 2, Method -> "Agglomerate"];
Graphics[{Green, Line /@ greenLines, Yellow, Line /@ yellowLines}] 