algorytm.org

Implementacja w Ada



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Przynależność punktu do wielokąta - Implementacja w Ada
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
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;
Dodaj komentarz