1
$\begingroup$

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[[1]] - b[[1]])^2 + (a[[2]] - b[[2]])^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]][[1]], tripleList[[i]][[2]],
 tripleList[[i]][[3]]]], tripleList[[i]]}, {i, Length[tripleList]}]

Here I order the "possTripleList" by the area

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

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"...]
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – LouisB Oct 31 '16 at 20:43
  • $\begingroup$ @LouisB wouldn't I have to redefine my 3 functions though? (d,semi, and area) $\endgroup$ – Brandon Oct 31 '16 at 21:05
  • $\begingroup$ You can keep those functions and define a version of area that takes only one argument. For example, area[x_List]:= area[x[[1]], ...]. 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. $\endgroup$ – LouisB Oct 31 '16 at 21:36
3
$\begingroup$

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],
          #[[1]] >= 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"}]
]

min area well triangles

$\endgroup$
  • $\begingroup$ Very cool Kenny! $\endgroup$ – Brandon Nov 1 '16 at 0:07
1
$\begingroup$
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]

enter image description here

$\endgroup$
  • $\begingroup$ That's badass!! $\endgroup$ – Brandon Nov 1 '16 at 5:15

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.