Лабораторна робота №3.2

Тема. Побудова опуклої оболонки
Мета. Формування навиків розв’язання задач геометричного змісту

Завдання
Розробити і реалізувати у вигляді програми алгоритм побудови опуклої оболонки методом перебору.

Перебірний алгоритм побудови опуклої оболонки

1.   Використовуючи вкладений цикл, перебираємо всі пари вершин.

2.   У кожної пари перевіряємо умову, щоб всі інші точки лежали по один бік від прямої, утвореної цією парою.

3.   Якщо умова виконується, додаємо цю пару до масиву включених вершин.

4.   Роздруковуємо список включених вершин.

Для виконання такого алгоритму необхідно вміти визначати положення точки відносно прямої.

Умова того, що точка з координатами (x0;y0) лежить на прямій з коефіцієнтами: a, b, c:  ax0+by0+c=0 Умова того, що точки з координатами (x1;y1) та (x2;y2) лежать по один бік від прямої з коефіцієнтами: a, b, c:  (ax1+by1+c)(ax2+by2+c)>0 Умова того, що точки з координатами (x1;y1) та (x2;y2) лежать по різні боки від прямої з коефіцієнтами: a, b, c: (ax1+by1+c)(ax2+by2+c)<0

Для відображення фігур на формі розмістимо два компоненти PaintBox. Для них встановіть розміри: 

width = 161, height = 161.

Код програми мовою Pascal в середовищі Delphi

const

  xmin=-8;xmax=8;

  ymin=-8;ymax=8;

  xwmin=0; ywmin=0;

  xwmax=160; ywmax=160;  //Висота та ширина PaintBox1 та PaintBox1 має бути рівною 161

var  x,y:array[1..100] of real;

     n:integer;

     masV:array[1..100] of integer;

Function IsOneSide(v1,v2:Integer):Boolean;

var   A, B, C, x1, y1, x2, y2,r:real;

      flag:boolean;

      i,j:integer;

begin

        //Визначаємо координати вершин v1 та v2

        x1 := x[v1];

        y1 := y[v1];

        x2 := x[v2];

        y2 := y[v2];

        //Визначаємо коефіцієнти прямої

        A := y2 - y1;

        B := x1 - x2;

        C := y1 * x2 - x1 * y2;

        flag := True;

        //Шукаємо першу точку

        For i := 1 To n do begin

            If (i = v1) Or (i = v2) Then Continue;

            x1 := x[i];

            y1 := y[i];

            break;

        end;

        //Перевіряємо всі інші точки

        For i := 1 To n do begin

            If (i = v1) Or (i = v2) Then Continue;

            x2 := x[i];

            y2 := y[i];

            r := (A * x1 + B * y1 + C) * (A * x2 + B * y2 + C);

            If r <= 0 Then begin

                flag := False;

                break;

            End;

        end;

        IsOneSide := flag

End;

function convertX(x:real):integer;

begin

  convertX:=Round(xwmin+(xwmax-xwmin)*((x-xmin)/(xmax-xmin)));

end;

function convertY(y:real):integer;

begin

  convertY:=Round(ywmax-(ywmax-ywmin)*((y-ymin)/(ymax-ymin)));

end;

procedure Draw(Pict:TPaintBox; n:integer; b:boolean);

var i,j:integer;

    M:integer;

    x0,y0:real;

begin

        //Малюємо сітку

        Pict.Canvas.Pen.Color := clGray;

        For i := -8 To 8 do begin

            Pict.Canvas.MoveTo(convertX( i),convertY( 8));

            Pict.Canvas.LineTo(convertX( i),convertY(-8));

            Pict.Canvas.MoveTo(convertX( 8),convertY( i));

            Pict.Canvas.LineTo(convertX(-8),convertY( i));

        end;

        //Малюємо координатні осі

        Pict.Canvas.Pen.Color := clBlue;

        Pict.Canvas.MoveTo(convertX( 0),convertY( 8));

        Pict.Canvas.LineTo(convertX( 0),convertY(-8));

        Pict.Canvas.MoveTo(convertX( 8),convertY( 0));

        Pict.Canvas.LineTo(convertX( 7),convertY(0.2));

        Pict.Canvas.MoveTo(convertX( 8),convertY( 0));

        Pict.Canvas.LineTo(convertX( 7),convertY(-0.2));

       

        Pict.Canvas.MoveTo(convertX( 8),convertY( 0));

        Pict.Canvas.LineTo(convertX(-8),convertY( 0));

        Pict.Canvas.MoveTo(convertX( 0),convertY( 8));

        Pict.Canvas.LineTo(convertX( 0.2),convertY(7));

        Pict.Canvas.MoveTo(convertX( 0),convertY( 8));

        Pict.Canvas.LineTo(convertX( -0.2),convertY(7));

       

        Pict.Canvas.Pen.Color := clBlack;

        Pict.Canvas.TextOut(convertX( 7),convertY( -1),'X');

        Pict.Canvas.TextOut(convertX( -1),convertY( 7),'Y');

        Pict.Canvas.TextOut(convertX( -1),convertY( -0.45),'0');

        Pict.Canvas.Pen.Color := clRed;

        Pict.Canvas.Pen.Width :=2;

        //Малюємо ламану

        if b then begin //зображуємо всі точки

            x0 := x[1]; y0 := y[1];

            Pict.Canvas.MoveTo(convertX( x0),convertY( y0));

            For i := 2 To n do

                Pict.Canvas.LineTo(convertX(x[i]),convertY(y[i]));

            //Замикаємо ламану

            Pict.Canvas.LineTo(convertX(x0),convertY(y0));

        end else

        begin

          //Шукаємо першу точку, яка входить до опуклої оболонки

          j:=1;

          while  (masV[j]<>1) and (j<=n) do j:=j+1;

          if j>n then exit;

          x0:=x[j]; y0:=y[j];

          Pict.Canvas.MoveTo(convertX(x0),convertY(y0));

          for i := j+1 to n do

              if masV[i]=1 then

                  Pict.Canvas.LineTo(convertX(x[i]),convertY(y[i]));

          Pict.Canvas.LineTo(convertX(x0),convertY(y0));

        end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

    i,j,w:integer;

    s:string;

begin

        //Зчитуємо координати

        For i := 1 To Memo1.Lines.Count do begin

            s := Memo1.Lines[i-1];

            s := Trim(s);

            while pos('  '{2 пробіли},s)<>0 do delete(s,pos('  '{2 пробіли},s),1);

            If (s <> '') and (pos(' '{1 пробіл},s)<>0) Then begin

                w := pos(' '{1 пробіл},s);

                x[i] := StrToFloat(copy(s,1,w-1));

                y[i] := StrToFloat(copy(s,w+1,Length(s)-w));

            end

        end;

        n:=Memo1.Lines.Count;

        //

        //Оголошуємо масив для включених вершин до масиву

        //оболонки

       For i := 1 To n  do  masV[i] := 0 ;

        //Переглядуємо, всі пари вершин

        For j := 1 To n do begin

            For i := 1 To n do begin

                If (i = j) Or (masV[i] = 1) Then Continue;

                If IsOneSide(j, i) Then begin

                    masV[i] := 1;

                    masV[j] := 1;

                    break;

                End;

            end;

        end;

        //Виводимо результат (перелік номерів вершин,

        //які входять до опуклої оболонки

        Memo2.Text := '';

        For i := 1 To n do begin

            If masV[i] = 1 Then begin

                Memo2.Lines.Add(IntToStr(i));

            End;

        End;

        Draw(PaintBox1,n,true);

        Draw(PaintBox2,n,false);

end;

Завдання для самостійного виконання  
Побудувати опуклу оболонку для фігур, заданих для вашого варіанту