Nadesłany przez Tomasz Lubiński, 03 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Polygon.adb:
-- -- Algorytm sprawdza, czy punkt p nalezy do wielokata W -- Program zostal pobrany ze strony www.algorytm.org -- (c)2007 Tomasz Lubinski -- with Text_IO; use Text_IO; procedure Polygon is type point is record x: Integer; y: Integer; end record; type points is array (0..1000) of point; polygon: points; r, tmp, p: point; k: Integer; max_x : Integer := Integer'First; -- Najwieksza rzedna j : Integer := 0; -- Aktualny index tablicy wierzcholkow n : Integer := 0; -- Liczba wierzchalkow wielokata s : String := " "; l : Integer; -- Wyznacznik macierzy kwadratowej stopnia 3. function det(x: point; y: point; z: point) return Integer is begin return (x.x*y.y + y.x*z.y + z.x*x.y - z.x*y.y - x.x*z.y - y.x*x.y); end; function przynaleznosc(x: point; y: point; z: point) return Boolean is deter : Integer; begin deter := det(x, y, z); if (deter/=0) then return False; else if ((Integer'min(x.x, y.x) <= z.x) and then (z.x <= Integer'max(x.x, y.x)) and then (Integer'min(x.y, y.y) <= z.y) and then (z.y <= Integer'max(x.y, y.y))) then return True; else return False; end if; end if; end; function przecinanie(a: point; b: point; p: point; r: point; polygon: points; k: Integer) return Boolean is begin if ((przynaleznosc(p, r, a) = False) and then (przynaleznosc(p, r, b) = False)) then -- pólprosta nie przecina odcinka |AB| w koncach if ((det(p, r, a) * det(p, r, b) < 0) and then (det(a, b, p) * det(a, b, r) < 0)) then return True; else return False; end if; elsif ((przynaleznosc(p, r, a) = True) and then (przynaleznosc(p, r, b) = True)) then -- do pólprostej nalezy przynajmniej jeden koniec odcinka |AB| if (det(p, r, polygon((k-1+n) mod n)) * det(p, r, polygon((k+2) mod n)) > 0) then return False; else return True; end if; elsif ((przynaleznosc(p, r, polygon((k-1+n) mod n)) = True) or else (przynaleznosc(p, r, polygon((k+2) mod n)) = True)) then return False; else -- polprosta zawiera tylko wierzcholek if (przynaleznosc(p, r, b) = True) then tmp := a; return False; end if; if (przynaleznosc(p, r, a) = True) then if (det(p, r, tmp) * det(p, r, b)>0) then return False; else return True; end if; end if; end if; return False; end; procedure oblicz is l : Integer :=0; --liczba przeciec begin for i in 0..n-1 loop k := i; if (przynaleznosc(polygon(i), polygon((i+1) mod n), p) = True) then Put_Line("Punkt nalezy do krawedzi wielokata"); return; end if; if (przecinanie(polygon(i), polygon((i+1) mod n), p, r, polygon, k) = True) then l := l+1; end if; end loop; Put_Line("Rozwiazanie--------------"); Put_Line("Liczba przeciec: " & Integer'Image(l)); if ((l mod 2) = 0) then Put_Line("Punkt p NIE nalezy do wielokata\n"); else Put_Line("Punkt p nalezy do wielokata\n"); end if; end; begin Put_Line("Dane wejsciowe:"); Put_Line("Podaj wspolrzedne punktu:"); Put_Line("x="); Get_Line(s, l); p.x := Integer'Value(s); Put_Line("y="); s := " "; Get_Line(s, l); p.y := Integer'Value(s); Put_Line("Podaj liczbe punktow tworzacych wielokat:"); Put_Line("n="); s := " "; Get_Line(s, l); n := Integer'Value(s); for i in 0..n-1 loop Put_Line("Punkt " & Integer'Image(i+1)); s := " "; Put_Line("x="); Get_Line(s, l); polygon(i).x := Integer'Value(s); Put_Line("y="); s := " "; Get_Line(s, l); polygon(i).y := Integer'Value(s); if (polygon(i).x > max_x) then max_x := polygon(i).x; end if; end loop; -- Wyznaczanie wspólrzednych drugiego konca odcinka r.x := max_x+1; r.y := p.y; --Punkt r na pewno znajduje sie poza wielokatem Put_Line("Punkt r=(" & Integer'Image(r.x) & ", " & Integer'Image(r.y) & ")"); oblicz; end;