Выпуклый четырехугольник, Помогите упростить код Опции

[kristianu]

Задача: Даны 4 точки на плоскости (x1,y1),...,(x4,y4).Определить, образуют ли эти точки выпуклый четырехугольник.
Задача может и где-то и звучала, но я ищу более "эллигантный" подход. О критерии выпуклости помню только, то что векторное произведение векторов сторон должно быть одного знака...От этого и исходил в данном коде(еще, кстати не приятно, ведь, если мне даны только координаты (X,Y), то векторное произведение равно X1*Y2+X2*Y1 ??? ):

Код

Program Lab9;
Uses CRT;
Procedure NewVector(Var a1,b1,a2,b2:integer);
          begin
            a1:=a2-a1; b1:=b2-b1;
          end;
Function  VectPr(a1,b1,a2,b2:integer):integer;
          begin
            VectPr:=a1*b2+a2*b1;
          end;
Var
  x1,y1,x2,y2,x3,y3,x4,y4:integer;
Const
  Text='vvedite coordinati X,Y(cherez probel) tochki#';
Begin
 ClrScr;
 Textcolor(yellow);
 GotoXY(1,3);
 Writeln('Program for Lab9');
 writeln;
 Writeln(Text,'1:');
  readln(x1,y1);
 Writeln(Text,'2:');
  readln(x2,y2);
 NewVector(x1,y1,x2,y2);
 Writeln(Text,'3:');
  readln(x3,y3);
 NewVector(x2,y2,x3,y3);
 Writeln(Text,'4:');
  readln(x4,y4);
 NewVector(x3,y3,x4,y4);
 NewVector(x4,y4,x1,y1);
 TextColor(white);
 Writeln;
 if VectPr(x1,y1,x2,y2)>0 Then
    if (VectPr(x3,y3,x4,y4)>0) AND (VectPr(x4,y4,x1,y1)>0) Then
       if VectPr(x1,y1,x2,y2)>0 Then
          Writeln('chetirehugolnik vipucliy')
       else Writeln('chetirehugolnik ne vipucliy')
    else Writeln('chetirehugolnik ne vipucliy')
 else
    if (VectPr(x3,y3,x4,y4)<0) AND (VectPr(x4,y4,x1,y1)<0) Then
       if VectPr(x1,y1,x2,y2)<0 Then
          Writeln('chetirehugolnik vipucliy')
       else Writeln('chetirehugolnik ne vipucliy')
    else Writeln('chetirehugolnik ne vipucliy');
readln;

Вообщем помогите мне найти, более лаконичное решение, или хотя бы какие есть еще критерии выпуклости....

Сообщение отредактировано: volvo - 8.12.2005 22:35

[volvo]

Ищем более лаконичное решение

Меняй название, или тема перемещается в корзину... Правила для тебя никто не отменял.

Задача может и где-то и звучала, но я ищу более "эллигантный" подход.

То есть ты, даже не смотря на задачу, и на ее решение, уже утверждаешь, что она НЕэлегантна, и заведомо написана некрасиво? Интересный подход... Поиском пользуйся иногда !

[kristianu]

Меняй название, или тема перемещается в корзину... Правила для тебя никто не отменял.

Не злись, если бы я знал еще, как это сделать

"эллигантный" подход

По сравнению с моим!!! поиском пользовался и ничего путного, возможно не правильно искал ...
To: volvo Если можешь дай ссылочку, на схожую задачу, хотя суть темы была в преобразовании моего решения...

[volvo]

суть темы была в преобразовании моего решения...

Ну, тогда тебе надо бы ввести массивы (с элементом - записью

Type
  Vector = Record
    X, Y: Integer;
  End;

), и твоя программа сразу уменьшится в 4 раза...

P.S. Первое сообщение темы - кнопка "Правка" - и меняй название...

[kristianu]

P.S. Первое сообщение темы - кнопка "Правка" - и меняй название...

Так проблема в том что ее нет(я знаю, что она должна находится в правом нижнем углу )

твоя программа сразу уменьшится в 4 раза...

В 4 раза она не сократится, у меня был такой вариант, там свои траблы...

[volvo]

А если я ее сокращу больше, чем в 4 раза?

Приведи тот вариант, который у тебя был...

[kristianu]

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

[volvo]

kristianu,
а ты прогонял свою программу? Она же у тебя не работает вообще !!! Ты ее сначала приведи в рабочее состояние, а потом улучшай.

Доказательство:

vvedite coordinati X,Y(cherez probel) tochki#1:
2 2
vvedite coordinati X,Y(cherez probel) tochki#2:
3 5
vvedite coordinati X,Y(cherez probel) tochki#3:
5 4
vvedite coordinati X,Y(cherez probel) tochki#4:
4 1

chetirehugolnik ne vipucliy

Правда? А начерти на бумаге...

[kristianu]

Хм трабла... Когда проверял, перепроверял все работало...ладно не суть, переделаю...

[kristianu]

Быстро нашел!

Function  VectPr(a1,b1,a2,b2:integer):integer;
          begin
            VectPr:=a1*b2-a2*b1; {+\-}
          end;

Теперь должно работать

[volvo]

kristianu, я думаю, так будет поэлегантней?

Program Lab9;
Uses CRT;

const
  nPoints = 4;
type
  TPoint = record
    X, Y: integer;
  end;
  ArrType = Array[0 .. Pred(nPoints)] of TPoint;


Procedure CreateVector(Var a1, b1: Integer;
          a2, b2: Integer);
Begin
  a1 := a2 - a1; b1 := b2 - b1;
End;
Function Vector(A, B: TPoint): Integer;
Begin
  Vector := B.X*A.Y - A.X*B.Y;
End;

var
  Arr: ArrType;
  Ok: Boolean;
  i, pX, pY: Integer;

Begin

  For i := 0 To Pred(nPoints) Do Begin
    Write('Enter the #', i:2, ' point [X Y]: ');
    ReadLn(Arr[i].X, Arr[i].Y);
    If i = 0 Then Begin
      pX := Arr[i].X; pY := Arr[i].Y;
    End
    Else
      CreateVector(Arr[Pred(i)].X, Arr[Pred(i)].Y,
                   Arr[i].X, Arr[i].Y);
  End;
  CreateVector(Arr[Pred(nPoints)].X, Arr[Pred(nPoints)].Y,
               pX, pY);
  {$B+} { В принципе, можно убрать это было для отладки... Второй тоже }
  Ok := True;
  For i := 0 To Pred(nPoints) Do
    Ok := Ok and (Vector(Arr[i], Arr[Succ(i) mod nPoints]) > 0);
  {$B-}

  if Ok Then Writeln('Yes') Else WriteLn('No');
  ReadLn;
end.

[kristianu]

To: volvo , красота....
Но всеже не обещенные в 4 раза меньше ШУЧУ, лучше об этом забудем спасибо....
Это как раз весьма элегантно