Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

martes, 23 de enero de 2018

Teorema de Pick



Se debe al matemático Austriaco Georg Alexander Pick, de ascendencia judía y victima del holocausto nazi, quien lo publicó en 1899. El teorema da una fórmula para determinar el área A de los polígonos simples (no se auto cruzan, es una región conexa) cuyos vértices tienen coordenadas enteras, determinando el número de puntos con coordenadas enteras en su frontera fr y en su interior int, la fórmula es:

A = int - 1 + fr/2

En Mathematica

Lo desarrollaré sobre una cuadrícula 10x10 que contiene sus bordes, los puntos fr (frontera) se pintan de azul y los puntos int (interiores) de verde.

La función RegionBoundary[ ] nos determina los puntos sobre la frontera del polígono y la función RegionMember[ ] nos dice si un punto pertenece o no a la región.

puntos = Flatten[Table[{i, j}, {i, 0, 10}, {j, 0, 10}], 1];
Manipulate[pts = Floor[pts];
 pol = Polygon[pts]; int = {}; fr = {};
 a = 0; Do[
  Which[RegionMember[RegionBoundary[pol], puntos[[n]]], 
   AppendTo[fr, puntos[[n]]], 
   Head[RegionMember[pol, puntos[[n]]]] === RegionMember, a++, 
   RegionMember[pol, puntos[[n]]], AppendTo[int, puntos[[n]]]], {n, 
   121}];

 Grid[{{Grid[{{"Puntos interiores", Length[int]}, {"Puntos frontera", 
       Length[fr]}, {"Area=int-1+fr/2", 
       If[a == 0, (Length[int] - 1 + 
           Length[fr]/2) "\!\(\*SuperscriptBox[\(Unid\), \(2\)]\)", 
        "El polígono no es simple"]}}], 
    Graphics[{PointSize[0.04], Blue, Point[fr], Green, Point[int], 
      Pink, Opacity[0.2], EdgeForm[Directive[Dashed, Thick, Red]], 
      pol}, Axes -> True, GridLines -> {Range[0, 10], Range[0, 10]}, 
     PlotRange -> {{0, 10}, {0, 10}}, 
     ImageSize -> Large]}}], {{pts, {{0, 0}, {5, 9}, {10, 0}}}, 
  Locator, ContinuousAction -> False, LocatorAutoCreate -> True}, 
 SaveDefinitions -> True]



Se pueden mover los vértices capturándolos con el Mouse, y crear nuevos vértices con Alt+Click en Windows y Command+Click en Mac.



Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas


No hay comentarios.:

Publicar un comentario