Find the parallelogram with min area

Question

Such as we have such points

pts=Uncompress[FromCharacterCode[
  Flatten[ImageData[Import["https://i.stack.imgur.com/3bgou.png"], "Byte"]]]];

We can plot it:

ListPlot[pts]

I can find its "MinOrientedRectangle" by in-built BoundingRegion

Graphics[{Red, PointSize[.02], Point[pts], FaceForm[], 
  EdgeForm[Black], BoundingRegion[pts, "MinOrientedRectangle"]}]

But I hope to get the parallelogram with min area actually. Is there any method can do this?

Answer 1

Updated to add a faster method based on FindMinimum

Not very fast, but perhaps you can use something like the following:

minParallelogram[pts_] := NMinimize[
    {
    Abs[-d e+c f],
    Element[
        Alternatives @@ ConvexHullMesh[pts]["Coordinates"],
        Parallelogram[{a,b},{{c,d},{e,f}}]
    ]
    },
    {a,b,c,d,e,f}
]

For your example:

res = minParallelogram[pts]; //AbsoluteTiming

{7.6328, Null}

And a graphic:

Graphics[{
    Parallelogram[{a,b}, {{c,d}, {e,f}}] /. res[[2]],
    Red, Point[pts]
}]

FindMinimum

A faster version based on FindMinimum instead of NMinimize:

minParallelogram2[pts_] := Module[{mesh, x0, x1, y0, y1},
    mesh = ConvexHullMesh[pts];
    {{x0, x1}, {y0, y1}} = RegionBounds[mesh];
    FindMinimum[
        {
        Abs[-d e+c f],
        Element[
            Alternatives @@ mesh["Coordinates"],
            Parallelogram[{a,b}, {{c,d}, {e,f}}]
        ]
        },
        {
            {a, x0},
            {b, y0},
            {c, x1},
            {d, y0},
            {e, x0},
            {f, y1}
        }
    ]
]

Your test case:

res2 = minParallelogram2[pts]; //AbsoluteTiming

{0.157286, Null}

Much faster! And another graphic:

Graphics[{
    FaceForm[Green], Parallelogram[{a,b}, {{c,d}, {e,f}}] /. res2[[2]],
    Red, Point[pts]
}]