5
$\begingroup$

How could you random convex polygons where the points of the graph

$A(x_1,y_1) , B(x_2,y_2), ... $

come out, hopefully in rational format (a/b) in such a way that the total area of ​​the polygon is always be 1. The ranges for the x axis would be from -5 to 5 and the y axis from 0 to 5.

something like what is shown in the following code but that the x axis and also the y axis come out, but only the positive part, at least one stroke should rest on the x axis

Graphics`Mesh`MeshInit[];

randompoly := Module[{poly},
  While[Length[FindIntersections[
     poly = PolygonCombine @ SimplePolygonPartition @
     Polygon[RandomReal[{-1, 1}, {25, 2}]]]] > 0];
  poly]

 Graphics[{EdgeForm[Red], Yellow, randompoly}]

(********)

 Table[Graphics[p, ImageSize -> 100], {p, 
 RandomPolygon[{"Convex", 5}, 3]}]

edit

It seems I didn't explain well

a) The points can be integers, but if they are decimal, the ideal would be to represent them in the form p/q, to ​​avoid representing them in a periodic or semi-periodic form.

b) the polygon must have at least one side on the x-axis, the polygon must be positioned for all "y" greater than or equal to zero

c) the points of the polygon must be in the vertices of the figure

$\endgroup$
7
  • 2
    $\begingroup$ While generating any random polygon of area 1 isn't that complicated, generating one with rational number coordinates in its vertices seems like it'll be quite a bit more of a challenge. Picking uniformly from that possibility space seems much more difficult yet, if that is of any interest to you. $\endgroup$
    – eyorble
    Nov 18, 2022 at 1:12
  • 1
    $\begingroup$ If it is alright that the area can be 1 plus a tiny numerical error like 0.9999999999999998, then similarly to the answer by cvgmt, you could may use unscaledPts = {{0, 0}}~Join~{{RandomReal[{-5, 5}], 0}}~Join~Transpose[{RandomReal[{-5, 5}, 3], RandomReal[{0, 5}, 3]}]; $\endgroup$ Nov 18, 2022 at 8:25
  • 1
    $\begingroup$ then unscaledPoly=Polygon[unscaledPts] $\endgroup$ Nov 18, 2022 at 8:27
  • 1
    $\begingroup$ then scaledPts = unscaledPts/Sqrt[Area[unscaled˘poly]] // Rationalize[#, 0] &; $\endgroup$ Nov 18, 2022 at 8:28
  • 1
    $\begingroup$ then poly=Polygon[scaledPts]. $\endgroup$ Nov 18, 2022 at 8:28

2 Answers 2

6
$\begingroup$

Edit

  • We construct some random integer coordinate points which contain {0,0} and {c,0}.

  • select the convex polygons which have the integer square area.

  • scaling the polygon respect to the origin {0,0} by the factor λ = 1/Sqrt[Area[reg]]

SeedRandom[123];
Clear[data, regs, reg, λ, pts];
n = 14;
data := Block[{c = RandomInteger[{0, 10}]}, 
   Join[{{0, 0}, {c, 0}}, 
    Thread[{RandomInteger[{c, c + 10}, n], 
      RandomInteger[{0, 20}, n]}]]];
regs = Table[ConvexHullMesh[data], 200];
reg = Pick[regs, IntegerQ[Sqrt[Area@#]] & /@ regs][[1]];
λ = 1/Sqrt[Area[reg]];
pts = MeshPrimitives[reg, 1][[;; , 1, 1]];
pts = λ*pts;
Polygon[pts] // Area
Graphics[{{Opacity[.5], Cyan, Polygon[pts]}, {Red, 
   Point[pts]}, {Brown, Text[#, #, {-1, -1}] & /@ pts}}, Axes -> True,
  AxesOrigin -> {0, 0}]

1

enter image description here

$\endgroup$
1
  • $\begingroup$ (It is possible that at least one of the sides of the polygon breaks from the x axis, in addition that each execution generates another random polygon.) $\endgroup$
    – Pamela
    Nov 18, 2022 at 3:47
4
$\begingroup$

The first part of this answer ignores the condition that one edge must be aligned with the $x$-axis, for simplicity. To include this condition, see the comment at the end of this post.

This uses RandomPolygon, then rationalizes the coordinates, then rescales to set the area equal to $1$. Unlike the other answer, it rescales $x$ and $y$ components by two different (but approximately equal) rational numbers:

randomUnitAreaConvexRational[n_,dx_:1/10000] :=
  With[{c=Rationalize[RandomPolygon[{"Convex",n}][[1]],dx]},
    With[{a=Area[Polygon[c]]},
      With[{b=Rationalize[Sqrt[a],dx]},
        Polygon[c.{{1/b,0},{0,b/a}}]]]];

Example.

SeedRandom[123];
P = randomUnitAreaConvexRational[11];

MatchQ[P[[1]],{{_?ExactNumberQ..}..}]
(* True *)

Area[P]
(* 1 *)

RegionPlot[P]

enter image description here

Comment. To align one edge with the $x$-axis, replace RandomPolygon with randomPolygon in the code above, where

randomPolygon[args___] :=
  With[{c=RandomPolygon[args][[1]]},
    With[{r=RotationMatrix[{c[[2]]-c[[1]],{1,0}}]},
      Polygon[N[Chop[Map[r.(#-c[[1]])&,c]]]]]];
$\endgroup$
1
  • 1
    $\begingroup$ Very nice idea of using the liberty to use two scales to enforce both the rationality of the coordinates and the the perfect unit area of the polygon. +1 $\endgroup$ Nov 18, 2022 at 15:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.