(*----------------------------------------------------------------*
 * Functii ce opereaza cu poligoanele...
 *----------------------------------------------------------------*)
{$N+}
unit Poligon;
(*----------------------------------------------------------------*)
interface
uses Types;
(*----------------------------------------------------------------*)
procedure  ordon_polig_fi(var p: TabelPuncte; nr : TNrElem);

(* Lab 3 *)
function  aria_polig_simplu(var p: TabelPuncte; nr : TNrElem): TCoord;

(* Lab 4, Var 1 *)
function  Greedy(var p, S: TabelPuncte; nr : TNrElem): TNrElem;
procedure ordon_infas(var p: TabelPuncte; nr : TNrElem);
(* Lab 4, Var 2 *)
function  Graham(var p, S: TabelPuncte; nr : TNrElem): TNrElem;
(* Lab 4, Var 3 *)
function  Andrew(p: TabelPuncte; var S: TabelPuncte; nr : TNrElem): TNrElem;

(* Lab 5 *)
function aproape(var p: TabelPuncte; nr : TNrElem; var i1, i2: integer): TCoord;

(* Lab 6, Var 1 *)
function apart_conv(var p: TabelPuncte; nr : TNrElem; a: TPunct): boolean;
function gen_polig_conv(var p: TabelPuncte; nr : TNrElem; c: TPunct): TNrElem;
(* Lab 6, Var 2 *)
function  apart_stel(var p: TabelPuncte; nr : TNrElem; c, a: TPunct): boolean;
function  gen_polig_stel(var p: TabelPuncte; nr : TNrElem; c: TPunct): TNrElem;
(* Lab 6, Var 3 *)
function  apart_polig(var p: TabelPuncte; nr : TNrElem; s: TPunct): boolean;
(*----------------------------------------------------------------*)
implementation
uses Punct, Transf, IntersDr, crt, IOGeom, GrGeom;
(*----------------------------------------------------------------*)
function gen_polig_conv(var p: TabelPuncte; nr : TNrElem; c: TPunct): TNrElem;
var i: integer;
    lat, pas: TCoord;
    t: TPunct;
    u, v: TCoord;
begin
   gen_polig_conv := 0;
   if nr < 3 then exit;
  { gen_puncte(p, nr, max_x, max_y);  gen_polig_conv := Andrew(p, p, nr); }
   u   := M_PI * (nr-2) / nr;         {Unghiul poligonului regulat cu nr laturi}
   lat := (200) * sqrt(2*(1-cos(u))); {Latura poligonului regulat cu raza 200}
   pas := M_PI - u;

   p[0] := ZeroP;
   p[1].x := rand_real(lat)+1;
   p[1].y := rand_real(lat)+1;

   with p[1] do v := ArcTan2(y, x);

   for i := 2 to nr-1 do with t do begin
      y := abs(u - unghi_puncte(p[i-2], p[i-1], p[0]));
      if pas < y then y := pas;
      y := v - M_PI + u + (rand_real(2*y)-y);         {fi}
      x := lat / 10 + rand_real(lat - lat / 10);  {ro}
      v := y;
      cartez_punct(t, t);       {Obtinem coordonatele carteziene}
      sum_vec(p[i], p[i-1], t); {Apmlasam varful la locul sau, dupa varful precedent}
   end;
   nr := Andrew(p, p, nr); {Pentru orice eventualitate determinam infasuratoarea convexa}
   depl_polig_to(p, nr, c);
   gen_polig_conv := nr
end;
(*----------------------------------------------------------------*)
function  gen_polig_stel(var p: TabelPuncte; nr : TNrElem; c: TPunct): TNrElem;
var raz: integer;
    pas: TCoord;
    t: TPunct;
begin
   gen_polig_stel := 0;
   if nr < 3 then exit;
   {gen_puncte(p, nr, max_x, max_y); ordon_polig_fi(p, nr);}

   gen_polig_stel := nr;
   p[nr] := c;
   raz := 200; {Raza maxima a poligonului}
   pas := 2 * M_PI / nr;         {Pasul unghiular mediu de la un varf la altul}
   while nr > 0 do with t do begin
      dec(nr);
      x := raz * 0.1 + rand_real(raz * 0.9); {ro}
      y := nr * pas  + rand_real(pas);       {fi}
      cartez_punct(t, t);       {Trecem la coordonate carteziene}
      sum_vec(p[nr], t, c);     {Transformam punctul in sistemul de coordonate cu centrul c}
   end;
end;
(*----------------------------------------------------------------*)
(* Lab 3 *)
(*----------------------------------------------------------------*)
function aria_polig_simplu(var p: TabelPuncte; nr : TNrElem): TCoord;
var i: integer;
    A: TCoord;
begin
   {Initial aria este zero}
   A := 0;

   {Poligonul se imparte in trapeze si se aduna/scade dublul ariei trapezelor}
   dec(nr);
   for i := 0 to nr do                   { Sirul [i] este:            0 1 2 ... nr-2 nr-1 }
      with p[(i+1) mod nr] do            { Sirul [(i+1) mod nr] este: 1 2 3 ... nr-1  0   }
         A := A + (x-p[i].x)*(y+p[i].y);

   {<A> reprezinta dublul ariei poligonului, + sau -, in functie de directia de parcurgere}
   aria_polig_simplu := abs(A / 2);
end;
(*----------------------------------------------------------------*)
(* Lab 4, Var 1 *)
(*----------------------------------------------------------------*)
function Greedy(var p, S: TabelPuncte; nr : TNrElem): TNrElem;
var i,j,k,l,n: integer;
    t: TCoord;
    inter: array[0..MAX_ELEM-1] of byte;
begin
   {Presupunem ca toate punctele apartin infasuratoarei}
   for i := 0 to nr-1 do inter[i] := 0;

(* Varianta optimizata: triunghiurile se formeaza doar din puncte de pe potentiala infasuratoare *)

   {Formam toate triunghiurile posibile, preferabil din puncte de pe infasuratoare}
   for i :=  0  to nr-3 do if inter[i] = 0 then
    for j := i+1 to nr-2 do if inter[j] = 0 then
     for k := j+1 to nr-1 do if inter[k] = 0 then
       {Excludem din infasuratoare punctele interioare}
       for l := 0 to nr-1 do if inter[l] = 0 then
         if (l<>i) and (l<>j) and (l<>k) and    {Ne asiguram ca p[l] nu este unul din varfuri}
           apart(p[l], p[i], p[j], p[k]) then   {Daca p[l] apartine triunghiului, el este interior}
              inter[l] := 1;

   {Copiem punctele care nu sunt interioare in multimea solutie}
   n := 0;
   for i := 0 to nr-1 do if inter[i] = 0 then
   begin
      S[n] := p[i];
      inc(n);
   end;
   ordon_infas(S, n);
   Greedy := n;
end;
(*----------------------------------------------------------------*)
procedure ordon_infas(var p: TabelPuncte; nr : TNrElem);
var i, j, k: integer;
    z: TPunct;
    t: TCoord;
begin
   for i := 0 to nr-2 do
   begin
     j := i+1;

     {Comparam toate celelalte puncte din p cu vectorul (p[i],p[j])
      ca sa gasim punctul extrem din stanga acestui vector}
     for k := j+1 to nr-1 do
     begin
       t := sarrus(p[i], p[j], p[k]);
       if t > 0 then j := k else
       if t = 0 then if (p[k].x-p[i].x) * (p[j].x-p[k].x) > 0 then j := k;
     end;

     {Acum p[j] reprezinta urmatorul punct din infasuratoare}
     if j<>i+1 then
     begin
        {Copiem punctul gasit in pozitia i+1}
        z := p[i+1];
        p[i+1] := p[j];
        p[j] := z;
     end;
   end;
end;
(*----------------------------------------------------------------*)
(* Lab 4, Var 2 *)
(*----------------------------------------------------------------*)
function  Graham(var p, S: TabelPuncte; nr : TNrElem): TNrElem;
var z, t: TPunct;
    i, j: integer;
    l, c: PCell;
begin
  if nr < 4 then begin {Mai putin de 4 puncte totdeauna formeaza infasuratoare}
     Graham := nr; {Toate punctele apartin infasuratoarei}
     while nr > 0 do begin
        dec(nr);
        S[nr] := p[nr];
     end;  exit;
  end;
  centru_polig(p, nr, z);              {1. Gasim centrul poligonului - z}
  depl_set_puncte(p, p, nr, -z.x, -z.y);  {2. Deplasam poligonul in originea de coordonate z}
  ordon_polig_fi(p, nr);               {3. Ordonam punctele dupa cresterea unghiului format cu axa absciselor}
  c := Puncte2List(p, nr);             {4. Cream lista circulara}
                                       {5. Cautam punctul cu ordonata minima - l}
  l := c^.urm;
  for i := nr downto 1 do begin
     if c^.p^.y < l^.p^.y then l := c;
     c := c^.prec;
  end;    { Acum l este punctul cu ordonata minima => apartine infasuratoarei }

                                       {6. Excludem din lista punctele care nu apartin infasuratoarei}

  c := l;  {Sa nu-l atingem pe l - primul element din lista!}
  while (c^.urm <> l) do begin
     {Consideram tripletul de puncte (c^.p^),(c^.urm^.p^),(c^.urm^.urm^.p^) }
     if sarrus(c^.p^, c^.urm^.urm^.p^, c^.urm^.p^) > 0 then
        c := c^.urm          {Ne deplasam inainte pe lista}
     else begin
         ThrowCell(c^.urm);  {c^.urm se exclude din lista, fara a rupe lantul}
         if c <> l then      {Ne deplasam inapoi pe lista, dar nu mai departe de l}
            c := c^.prec;
     end;
  end;

  nr := List2Puncte(l, S);             {7. Lista l contine infasuratoarea convexa}

  {Sa deplasam sistemul de puncte la centrul de coordonate original}
  depl_set_puncte(S, S, nr, z.x, z.y);

  Graham := nr;  {Sfarsit!!!}
end;
(*----------------------------------------------------------------*)
(* Lab 4, Var 3 *)
(*----------------------------------------------------------------*)
function  Andrew(p: TabelPuncte; var S: TabelPuncte; nr : TNrElem): TNrElem;
var b: integer;
    i, j, u, v, x, y: TNrElem;
    m: ^TElem;
    r: TCoord;

begin
   {1. Determinam punctele de ordonata minima si maxima}
   u := 0; v := nr-1;
   for i := nr-2 downto 1 do
   begin
     if p[i].y < p[u].y then u := i;
     if p[v].y < p[i].y then v := i;
   end;
   {Amplasam punctele de ordonata minima/maxima la capetele listei}
   {Totodata rezervam p[nr-1] pentru operatia de sortare}
   p[nr] := p[v];       {maxim}
   if u <> 0 then begin
      p[v] := p[0];
      p[0] := p[u];     {minim}
      v := u;
   end;
   if v <> nr-1 then  p[v] := p[nr-1]; {p[nr-1] e liber}

   {p[0]       - ordonata minima}
   {p[nr]      - ordonata maxima}
   {p[1..nr-2] - punctele de sortat}

   {2. Separam p in doua submultimi, in functie de pozitia
       fata de vectorul (p[0],p[nr])}
   u := 0;
   v := nr;
   new(m); {Alocam spatiu pentru lista de permutari}
   m^[u] := u;  {Sfirsitul S1}
   m^[v] := v;  {Inceputul S2}
   for i := nr-2 downto 1 do begin
      r := sarrus(p[0], p[nr], p[i]);
      if r > 0 then begin {S1}
         inc(u);
         m^[u] := i;
      end else
      if r < 0 then begin {S2}
         dec(v);
         m^[v] := i;
      end;
      {Punctele de pe dreapta (p[0],p[nr]) sunt ignorate (r=0)}
   end;
   {Acum p[m^[0]..m^[u]] = S1, p[m^[v]..m^[nr]] = S2}

   {3. Sortarea dupa ordonata}
   QSort_y(p, 1, u, m^);
   QSort_y(p, v, nr-1, m^);

   {4. Excludem punctele care nu sunt pe infasuratoare}

   {a. Verificam tripletele formate din S1}
   m^[u+1] := m^[nr]; {Punctul cu ordonata maxima}
   x := 0;   {Ultimul element din infasuratoare}
   i := x+1; {Punctul care se verifica}
   j := i+1; {Un punct oarecare din S1}
   while i <= u do {Se verifica toate punctele pana la u, inclusiv}
   begin
     if sarrus(p[m^[x]], p[m^[j]], p[m^[i]]) > 0 then
     begin     {Miscarea inainte}
        inc(x);
        if x <> i then m^[x] := m^[i];
        i := j;
        inc(j);
     end else  {Miscarea inapoi}
       if x > 0 then begin {Daca nu s-a ajuns la primul element}
         i := x;
         dec(x);
       end else begin      {Daca x e primul element, mergem tot inainte}
         i := j;
         inc(j);
       end;
   end;

   {b. Verificam tripletele formate din S2}
   m^[v-1] := m^[0];  {Punctul cu ordonata minima}
   y := nr;  {Ultimul element din infasuratoare}
   i := y-1; {Punctul care se verifica}
   j := i-1; {Un punct oarecare din S2}
   while i >= v do {Se verifica toate punctele pana la v, inclusiv}
   begin
     if sarrus(p[m^[y]], p[m^[j]], p[m^[i]]) > 0 then
     begin          {Miscarea inainte}
        dec(y);
        if y <> i then m^[y] := m^[i];
        i := j;
        dec(j);
     end else       {Miscarea inapoi}
       if y < nr then begin {Daca nu s-a ajuns la primul element}
         i := y;
         inc(y);
       end else begin       {Daca y e primul element, mergem tot inainte}
         i := j;
         dec(j);
       end;
   end;

   {5. Formam solutia: S1 + S2}
   for i := 0    to   x do S[i]      := p[m^[i]];
   inc(x); {Nr. nr de elemente din S1}
   for i := nr downto y do S[x+nr-i] := p[m^[i]];
   dec(y); {Omologul lui x}
   Andrew := x + nr - y;  {Nr. de elemente}

   dispose(m);
end;
(*----------------------------------------------------------------*)
(* Lab 5 *)
(*----------------------------------------------------------------*)
function aproape(var p: TabelPuncte; nr : TNrElem; var i1, i2: integer): TCoord;
var i, j: integer;
    r, ro: TCoord;
begin
   i1 := 0;
   i2 := 1;
   ro := dist(p[i1], p[i2]);
   for i := 0 to nr-2 do
     for j := i+1 to nr-1 do
     begin
       r := dist(p[i], p[j]);
       if r < ro then begin
         ro := r;
         i1 := i;
         i2 := j;
       end;
     end;
   aproape := ro;
end;
(*----------------------------------------------------------------*)
procedure  ordon_polig_fi(var p: TabelPuncte; nr : TNrElem);
var m: ^TElem;
    s: ^TabelPuncte;
    i: TNrElem;
begin
  {Salvam coordonatele carteziene in s^}
  new(s);
  for i := nr-1 downto 0 do s^[i] := p[i];

 {Sa trecem la coordonate polare in felul urmator:
     p[i].y = fi - unghiul
     p[i].x = ro - distanta  }
  polar_set_puncte(p, p, nr);

  {m^ este tabelul de permutari}
  new(m);
  for i := nr-1 downto 0 do m^[i] := i;

  {Sortarea dupa y - unghiul cu Ox, in m}
  QSort_y(p, 0, nr-1, m^);

  for i := nr-1 downto 0 do p[i] := s^[m^[i]];
  dispose(s);
  dispose(m);
end;
(*----------------------------------------------------------------*)
(* Lab 6, Var 1 *)
(*----------------------------------------------------------------*)
function apart_conv(var p: TabelPuncte; nr : TNrElem; a: TPunct): boolean;
var t: TCoord;
begin
  apart_conv := false;
  if nr < 3 then exit; {Poligonul are cel putin 3 laturi}
  t := sarrus(p[0], p[nr-1], a);
  while nr > 1 do begin
     dec(nr);
     if sarrus(p[nr], p[nr-1], a)*t < 0 then exit;
  end;
  apart_conv := true;
end;
(*----------------------------------------------------------------*)
(* Lab 6, Var 2 *)
(*----------------------------------------------------------------*)
function  apart_stel(var p: TabelPuncte; nr : TNrElem; c, a: TPunct): boolean;
var i: TNrElem;
{c este de aceeasi parte in raport cu toate laturile poligonului}
begin
  apart_stel := true;
  if nr < 3 then exit; {Poligonul are cel putin 3 laturi}
  if apart(a, p[0], p[nr-1], c) then exit;
  for i := nr-1 downto 1 do
     if apart(a, p[i], p[i-1], c) then exit;
  apart_stel := false;
end;
(*----------------------------------------------------------------*)
(* Lab 6, Var 3 *)
(*----------------------------------------------------------------*)
function  apart_polig(var p: TabelPuncte; nr : TNrElem; s: TPunct): boolean;
var i, j, k: integer;
    t, u, v: TCoord;
begin
    { Fie l dreapta ce trece prin s, paralela la Ox }
    k := 0;            {Numarul de intersectii cu dreapta l la stanga lui s}
    j := nr-1;         {Ultimul punct analizat}
    u := p[j].y - s.y; {Ultima ordonata care nu se afla pe l}
    for i := 0 to nr-1 do with p[i] do
    begin
      if y <> s.y then
      begin {p[i] nu se afla pe l}
        v := y - s.y;
        if u*v < 0 then begin {Domeniul a fost intersectat de dreapta l}
          if p[j].y = s.y then t := p[j].x                             {intersectat intr-un varf al poligonului}
                          else t := x + (p[j].x-x)*(s.y-y)/(p[j].y-y); {intersectat pe o latura a poligonului}
          {t este abscisa punctului de intersectie cu l}
          if t <= s.x then inc(k); {Daca a fost intersectat la stanga de s}
        end;
        u := v;
      end else begin {p[i] se afla pe l}
         if (p[j].y = s.y) and intre_val(s.x, p[j].x, x) then begin
            {Se afla pe latura p[j]p[i]}
            apart_polig := true;
            exit;
         end;
      end;
      j := i;
    end;
    apart_polig := k mod 2 = 1;
end;
(*----------------------------------------------------------------*)

end.