(*----------------------------------------------------------------* * 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); { 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.