# Maximizing the Area of a triangle with given coordinates (and more)

I am trying to find the MAXIMIZED area(s) of a triangle given a bunch of coordinates. I will explain each part of my code and explain more in depth to this task..This task is to take 3 coordinate pairs and produce the area. This application is used in determining where to place water wells, such that the entire plot of land is used most efficiently for crops. At the very end I'll show you where I am having trouble in completing this task.

 Clear[d, a, b, c, d, semi, area, wellList, tripleList,  possTripleList,  orderedTripleList, bestTripleWells, bestWells];


"wellList" is my possible coordinates of location (somewhere in quadrant 1, for now they can be any coordinates)

wellList = {{0, 0}, {100, 300}, {175, 225}, {200, 350}, {400, 500}};


Here is my "Area" function nested with a distance function and perimeter function, I am using Herons Formula

  d[a_, b_] := Sqrt[(a[] - b[])^2 + (a[] - b[])^2];

semi[a_, b_, c_] := (d[a, b] + d[a, c] + d[b, c])/2;

area[a_, b_, c_] := Sqrt[semi[a, b, c]*(semi[a, b, c] - d[a, b])*
(semi[a,b,c] - d[a, c])*(semi[a, b, c] - d[b, c])];


Here is my list of tuples (all the possible ways to arrange the coordinates in sets of 3, used to then find the area)

 tripleList = Subsets[wellList, {3}]


Now I am going to iterate over my "tripleList" to produce the areas that correspond to each list in "tripleList"

 possTripleList = Table[{N[area[tripleList[[i]][], tripleList[[i]][],
tripleList[[i]][]]], tripleList[[i]]}, {i, Length[tripleList]}]


Here I order the "possTripleList" by the area

 orderedTripleList = Sort[possTripleList, #1[] > #2[] &]


Now here is a nice grid format of the area along with the 3 coordinate pairs

 bestTripleWells = TableForm[Grid[Table[orderedTripleList[[i]], {i, Length
[wellList]}], Frame -> All]]


Now here is where I am having some trouble: I need to create a function such as "topWells" using my "wellList" from above, and produce a table of the top 3 wells that have the largest area, along with the 3 coordinate pairs that correspond to it. I have a minimum area of 20,000 that must be met. Meaning if I were to edit my "wellList" so that none of the areas are greater than 20,000 then I want to be able to print out a sentence like "maximum area not met" or something like that. I was going to try to use "TakeLargest" in my final function, but TakeLargest only works on lists and I was having some complications with it.

I was thinking something like

 bestWells[wellList]:= If[ ..."stuff"...]

• You could just use your area function to sort tripleList. Something like Sort[tripleList, area[#1]>area[#2]&]. But first define area for a list of points. Oct 31, 2016 at 20:43
• @LouisB wouldn't I have to redefine my 3 functions though? (d,semi, and area) Oct 31, 2016 at 21:05
• You can keep those functions and define a version of area that takes only one argument. For example, area[x_List]:= area[x[], ...]. Your single argument version would be defined in terms of the 3-argument version. By the way, also see the documentation on the Triangle and the Area functions. Oct 31, 2016 at 21:36

This is a function returning a triangle's area, given three vertices:

TriangleArea[{{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] :=
Abs[(x3 (-y1 + y2) + x2 (y1 - y3) + x1 (-y2 + y3))/2]


The following function calculates the area of all possible triangles of well positions, and selects those triangles greater than or equal to an input minimum area.

bestWells[wells_List, minArea_] :=
Select[
SortBy[Map[{TriangleArea[#], #} &, Subsets[wells, {3}]], First],
#[] >= minArea &] /. {} -> "No Such Wells"


For example,

With[{wells = {{0, 0}, {100, 300}, {175, 225}, {200, 350}, {400, 500}}},
Manipulate[
bestWells[wells, minArea],
{{minArea, 10000}, 100, 10^5, 100, Appearance -> "Labeled"}]
] • Very cool Kenny! Nov 1, 2016 at 0:07
ar[p1_, p2_, p3_] :=
Module[{q1, q2, q3}, {q1, q2, q3} = {##, 0} & @@@ {p1, p2, p3};
Norm[Cross[q3 - q1, q2 - q1]]/2];
su = Subsets[wellList, {3}];
ord = Ordering[ar @@@ su];


so using wellList:

Grid[Partition[(Show[
Graphics[{FaceForm[None], EdgeForm[Black], Black,
Polygon@#} & /@ su],
Graphics[{Red, Opacity[0.5], Polygon@#, Blue, PointSize[0.1],
Point[wellList]}], PlotLabel -> Row[{"area: ", ar @@ #}]] & /@
su)[[ord]], 5], Frame -> All] • That's badass!! Nov 1, 2016 at 5:15