Задачи по аналитической геометрии. Опции

[Liba]

Помогите решить 2 задачки.....очень надо....

1)Есть 3 окружности разных диаметров с разными центрами.Нужной найти все точки пересечения окружностей.

2)На плоскости хаотично расположены точки(n) нужно посторить минимальный многоугольник(не треугольник).Вывести результат координат и кол-во точек многоугольника.

Заранее огромное спасибо!!!!!

P.S.Я вообще не понимаю как это надо делать.... :p2:

[Digitalator]

задача1

Ты что, математику не знаешь???????

задача2

Что есть "Минимальный многоугольник"? Минимальная площадь или периметр или еще как? И как он строится относительно точек - закрывает их всех?

[xds]

Предсказываю: имеется в виду выпуклый многоугольник минимальной площади, внутри которого лежат все точки множества... ;)

Сообщение отредактировано: xds - 28.10.2004 7:43

[Altair]

Между прочим, первую задачу, решит не каждый, если я добавлю такое условие:
дан рисунок BMP с 3 окружностями, найти точки пересечения.

посторить минимальный многоугольник

ТОже не так все просто, конечно правила девушка не читала, итему надо было бы закрыть, но ... ладно, переименую ...

ЧТо значит минимальный многоугольник? Если по минимальной длинне его периметра, это одно, если по площади, это другое.

[volvo]

Насколько я помню, в общем случае первая задача решается так:

Код

Type
 TPoint =
   Record
     x, y: Double;
   End;
 TCircle =
   Record
     x, y, r: Double;
   End;

Const
 Epsilon = 0.001;

 n = 3;
 { координаты заданы для тестирования }
 arrCircles: Array[1 .. n] Of TCircle =
   ((x:- 5; y:4; r:4),
    (x:- 6; y:4; r:1),
    (x:-10; y:8; r:3) );

Var
 amount: Integer;
 { здесь хранятся координаты точек пересечения }
 InterPoint: Array[1 .. 2*n] Of TPoint;


Function CircleIntersect( cr1, cr2: TCircle ): Integer;
 Var
   p1, p2: TPoint;
   q, a, b, c, D: Double;
   Dist: Double;
 Begin
   Dist := Sqrt( Sqr(cr2.x - cr1.x) +
                 Sqr(cr2.y - cr1.y));

   cr2.x := cr2.x - cr1.x;
   cr2.y := cr2.y - cr1.y;

   CircleIntersect := 0;
   If (Abs(Dist) < Epsilon) or (Dist > cr1.r + cr2.r) or
      (Dist < Abs(cr1.r - cr2.r)) Then Exit;

   CircleIntersect := 1;
   If Abs(Dist - (cr1.r + cr2.r)) < Epsilon Then
     Begin
       p1.x := (cr2.x * cr1.r) / Dist;
       p1.y := (cr2.y * cr1.r) / Dist;

       p1.y := p1.y + cr1.y;
       p1.x := p1.x + cr1.x;

       Inc(Amount);
       InterPoint[Amount] := p1;
       Exit
     End;

   If cr2.x = 0 Then
     Begin
       p1.y := (Sqr(cr2.y) + Sqr(cr1.r) - Sqr(cr2.r)) /
              (2 * cr2.y);
       p1.x := Sqrt(Sqr(cr1.r) - Sqr(p1.y));
       p2.x := -p1.x;
       p2.y := p1.y;
     End
   Else
     Begin
       q := Sqr(cr1.r) - Sqr(cr2.r) + Sqr(cr2.x) + Sqr(cr2.y);
       a := 4 * (Sqr(cr2.y) + Sqr(cr2.x));
       b := (-4) * cr2.y * q;
       c := Sqr(q) - 4 * Sqr(cr1.r) * Sqr(cr2.x);
       D := Sqr(b) - 4 * a * c;

    p1.y := ((-b + Sqrt(D))/(2*a));
    p2.y := ((-b - Sqrt(D))/(2*a));
    p1.x := ((Sqr(cr1.r) - Sqr(cr2.r) +
               Sqr(cr2.x) + Sqr(cr2.y) -
               2*cr2.y*p1.y) / (2*cr2.x));
    p2.x := ((Sqr(cr1.r) - Sqr(cr2.r) +
               Sqr(cr2.x) + Sqr(cr2.y) -
               2*cr2.y*p2.y) / (2*cr2.x));
     End;

   p1.y := p1.y + cr1.y;
   p2.y := p2.y + cr1.y;
   p1.x := p1.x + cr1.x;
   p2.x := p2.x + cr1.x;

   Inc(Amount);
   InterPoint[Amount] := p1;

   Inc(Amount);
   InterPoint[Amount] := p2;
   CircleIntersect := 2
 End;

Var
 i, j: Integer;
Begin
 For i := 1 To n Do
   Begin
     WriteLn( 'Окружность #', i );
     Write( 'X центра>' ); ReadLn(arrCircles[i].x);
     Write( 'Y центра>' ); ReadLn(arrCircles[i].y);
     Write( 'Радиус>' ); ReadLn(arrCircles[i].r);
   End;

 Amount := 0;
 For i := 1 To n Do
   For j := Succ(i) To n Do
     CircleIntersect(arrCircles[i], arrcircles[j]);


 WriteLn( 'Найдено точек:', Amount );
 For i := 1 To Amount Do
   WriteLn( 'точка #', i, ': x = ', interpoint[i].x:7:3,
                          '  y = ', interpoint[i].y:7:3 )
End.

Можно еще добавить проверку на совпадающие точки ... :p2:

Сообщение отредактировано: volvo - 28.10.2004 16:26

[Liba]

Спасибо!!!
А почему когда я ее запускаю мне вылетает окно с ошибкой где пишется:runtime error 103 at 0000477C я программирую через делфи..... ;)

[volvo]

Только что прогнал программу в Дельфи -

Код

program Project1;

{$APPTYPE CONSOLE}

uses
 SysUtils;

Type
TPoint =
  Record
    x, y: Double;
  End;
TCircle =
  Record
    x, y, r: Double;
  End;

Const
Epsilon = 0.001;

n = 3;
Var
arrCircles: Array[1 .. n] Of TCircle;

Var
amount: Integer;
{ здесь хранятся координаты точек пересечения }
InterPoint: Array[1 .. 2*n] Of TPoint;


Function CircleIntersect( cr1, cr2: TCircle ): Integer;
Var
  p1, p2: TPoint;
  q, a, b, c, D: Double;
  Dist: Double;
Begin
  Dist := Sqrt( Sqr(cr2.x - cr1.x) +
                Sqr(cr2.y - cr1.y));

  cr2.x := cr2.x - cr1.x;
  cr2.y := cr2.y - cr1.y;

  CircleIntersect := 0;
  If (Abs(Dist) < Epsilon) or (Dist > cr1.r + cr2.r) or
     (Dist < Abs(cr1.r - cr2.r)) Then Exit;

  CircleIntersect := 1;
  If Abs(Dist - (cr1.r + cr2.r)) < Epsilon Then
    Begin
      p1.x := (cr2.x * cr1.r) / Dist;
      p1.y := (cr2.y * cr1.r) / Dist;

      p1.y := p1.y + cr1.y;
      p1.x := p1.x + cr1.x;

      Inc(Amount);
      InterPoint[Amount] := p1;
      Exit
    End;

  If cr2.x = 0 Then
    Begin
      p1.y := (Sqr(cr2.y) + Sqr(cr1.r) - Sqr(cr2.r)) /
             (2 * cr2.y);
      p1.x := Sqrt(Sqr(cr1.r) - Sqr(p1.y));
      p2.x := -p1.x;
      p2.y := p1.y;
    End
  Else
    Begin
      q := Sqr(cr1.r) - Sqr(cr2.r) + Sqr(cr2.x) + Sqr(cr2.y);
      a := 4 * (Sqr(cr2.y) + Sqr(cr2.x));
      b := (-4) * cr2.y * q;
      c := Sqr(q) - 4 * Sqr(cr1.r) * Sqr(cr2.x);
      D := Sqr(b) - 4 * a * c;

p1.y := ((-b + Sqrt(D))/(2*a));
p2.y := ((-b - Sqrt(D))/(2*a));
p1.x := ((Sqr(cr1.r) - Sqr(cr2.r) +
              Sqr(cr2.x) + Sqr(cr2.y) -
              2*cr2.y*p1.y) / (2*cr2.x));
p2.x := ((Sqr(cr1.r) - Sqr(cr2.r) +
              Sqr(cr2.x) + Sqr(cr2.y) -
              2*cr2.y*p2.y) / (2*cr2.x));
    End;

  p1.y := p1.y + cr1.y;
  p2.y := p2.y + cr1.y;
  p1.x := p1.x + cr1.x;
  p2.x := p2.x + cr1.x;

  Inc(Amount);
  InterPoint[Amount] := p1;

  Inc(Amount);
  InterPoint[Amount] := p2;
  CircleIntersect := 2
End;

Var
i, j: Integer;
Begin
For i := 1 To n Do
  Begin
    WriteLn( 'Окружность #', i );
    Write( 'X центра>' ); ReadLn(arrCircles[i].x);
    Write( 'Y центра>' ); ReadLn(arrCircles[i].y);
    Write( 'Радиус>' ); ReadLn(arrCircles[i].r);
  End;

Amount := 0;
For i := 1 To n Do
  For j := Succ(i) To n Do
    CircleIntersect(arrCircles[i], arrcircles[j]);


WriteLn( 'Найдено точек:', Amount );
For i := 1 To Amount Do
  WriteLn( 'точка #', i, ': x = ', interpoint[i].x:7:3,
                         '  y = ', interpoint[i].y:7:3 );
 ReadLn
End.

Вот в таком виде все отработало без проблем (на всякий случай, можно узнать, с какими координатами прогонялась программа?)

[Liba]

Предсказываю: имеется в виду выпуклый многоугольник минимальной площади, внутри которого лежат все точки множества... ;)

Совершенно точно ты предугодал....

[Guest]

Неучто никто не знает как сделать 2 задачку????

[Altair]

посторить минимальный многоугольник

А что значит минимальный?
по какому параметру он минимален?

[Guest]

да

имеется в виду выпуклый многоугольник минимальной площади, внутри которого лежат все точки множества..

[Guest]

Ну кто-нибудь решите программку???пожалуйста :p2:

[Liba]

Думаю я повтрарю задание....... ;)


На плоскости хаотично расположены точки(n) нужно посторить минимальный многоугольник(не треугольник).Вывести результат координат и кол-во точек многоугольника.
имеется в виду выпуклый многоугольник минимальной площади, внутри которого лежат все точки множества

Спасибо)))

[volvo]

Liba
Алгоритм описан здесь

[Liba]

Алгоритм алгоритмом.........а написать программу я так не могу((((

[Altair]

АУ!
Там есть блок схема!
скачайте редактор, в нем есть кнопка команда:
Импорт -> Паскаль.
И все, получите программу.
(толькоописать надо будет переменные)...

[Liba]

ОГРОМНЕЙШЕЕ СПАСИбО!!!!!!!!!!!!!
вЫ МНЕ ЗДОРОВО ПОМОГЛИ!!!!!!!!!!!!!! :priva: :kiss4: :priva: