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?

Przecinanie się odcinków - Implementacja w Ada
Ocena użytkownikóww: *****  / 2
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.

Odcinki.adb:
--
-- Program sprawdza, czy dwa odcinki sie przecinaja
-- Program pobrano ze strony www.algorytm.org
-- (c)2006 Tomasz Lubinski
--

with Text_IO;
use Text_IO;

procedure Odcinki is

   type point is record
      x: Integer;
      y: Integer;
   end record;
   
   -- wyznacznik macierzy
   function det_matrix(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;   
     
   -- Ta funkcja sprawdza, czy punkt z należy do odcinka |xy|
   function przynaleznosc(x: point; y: point; z: point) return Boolean is
   begin
      if det_matrix(x, y, z) /= 0 then 
         return False; 
      elsif 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;
     


   points: array(1..4) of point; -- punkty  
   s     : String := "                    ";
   ptr   : Integer := 0;
begin
          
   Put_Line("Wprowadzanie wspolrzednych punktow.");
   Put_Line("Odcinek 1");
   Put_Line("Punkt #1");
   Put_Line("x=");
   s := "                    ";
   Get_Line(s, ptr);
   points(1).x := Integer'Value(s);
   Put_Line("y=");
   s := "                    ";
   Get_Line(s, ptr);
   points(1).y := Integer'Value(s);
   Put_Line("Punkt #2");
   Put_Line("x=");
   s := "                    ";
   Get_Line(s, ptr);
   points(2).x := Integer'Value(s);
   Put_Line("y=");
   s := "                    ";
   Get_Line(s, ptr);
   points(2).y := Integer'Value(s);   
   Put_Line("Odcinek 2");
   Put_Line("Punkt #1");
   Put_Line("x=");
   s := "                    ";
   Get_Line(s, ptr);
   points(3).x := Integer'Value(s);
   Put_Line("y=");
   s := "                    ";
   Get_Line(s, ptr);
   points(3).y := Integer'Value(s);
   Put_Line("Punkt #2");
   Put_Line("x=");
   s := "                    ";
   Get_Line(s, ptr);
   points(4).x := Integer'Value(s);
   Put_Line("y=");
   s := "                    ";
   Get_Line(s, ptr);
   points(4).y := Integer'Value(s);     

   -- Sprawdzanie, czy jakiś punkt należy do drugiego odcinka
   if przynaleznosc(points(1), points(2), points(3)) or else
      przynaleznosc(points(1), points(2), points(4)) or else
      przynaleznosc(points(3), points(4), points(1)) or else
      przynaleznosc(points(3), points(4), points(2)) then      
       Put_Line("Odcinki sie przecinaja- przynaleznosc");
       return;
   end if;
               
   -- zaden punkt nie nalezy do drugego odcinka
   if ((det_matrix(points(1), points(2), points(3)))*(det_matrix(points(1), points(2), points(4)))>=0) then
      Put_Line("Odcinki sie NIE przecinaja"); 
   elsif ((det_matrix(points(3), points(4), points(1)))*(det_matrix(points(3), points(4), points(2)))>=0) then
      Put_Line("Odcinki sie NIE przecinaja");
   else -- znaki wyznaczników sa równe
      Put_Line("Odcinki sie przecinaja- punkty leza po przeciwnych stronach");
   end if;
   
end;
Dodaj komentarz