freepascal.ru

форум
https://freepascal.ru/forum/

Подскажите геометрию, пожалуйста

https://freepascal.ru/forum/viewtopic.php?t=5308

Страница 1 из 1

Подскажите геометрию, пожалуйста

Добавлено: 10.01.2010 05:08:16
avis
Имеется вектор в декартовой системе координат, как определить направлен он по часовой стрелке или против нее, относительно начала координат.
P.S. рисуется все на канве, соответственно начало координат - верхний левый угол канвы.
:oops:

Re: Подскажите геометрию, пожалуйста

Добавлено: 10.01.2010 11:38:53
Putnick
Уважаемый avis.
Позволю себе заметить, что формулировка
направлен он по часовой стрелке или против нее
— не корректна (скажем, если между двумя векторами ОДИН из углов = 90, это означает, что между ними 90 ПО ЧАСОВОЙ, или 270 ПРОТИВ?).
Впрочем, в своих старых завалах нашёл, нечто более-менее подходящее

Код: Выделить всё

program p6;
var
  X, Y, R,Angle,cos1,cos2:real;
begin
  Write('X координата вектора ');
  ReadLn(X);
  Write('Y координата вектора ');
  ReadLn(Y);
  R:=sqrt(X*X+Y*Y);
  if R=0 then begin
    Write('Задан нулевой вектор');
    Exit
  end;
  cos1:=X/R;
  cos2:=Y/R;
  if cos1=0 then Angle:=pi/2 else Angle:=arctan(sqrt(1-cos1*cos1)/cos1);
  Angle:=Angle*180/pi;
  if cos1>=0 then begin
    if cos2>=0 then Angle:=90-Angle else Angle:=90+Angle
  end else begin
    if cos2>=0 then Angle:=-90-Angle else Angle:=-90+Angle
  end;
  WriteLn('Вектор направлен под углом=',Angle:0:2)
end.

Надеюсь, смог помочь.
С Уважением, Алексей.

Re: Подскажите геометрию, пожалуйста

Добавлено: 10.01.2010 12:18:33
Astralis
функция arctan2 из модуля math к вашим услугам

Код: Выделить всё

{ calculates arctan(y/x) and returns an angle in the correct quadrant }
function arctan2(y,x : float) : float;

Re: Подскажите геометрию, пожалуйста

Добавлено: 10.01.2010 12:34:44
Putnick
Спасибо, Astralis.
К своему стыду, не знал, что всё так просто :oops: . Теперь буду знать.

С уважением, Алексей.

Re: Подскажите геометрию, пожалуйста

Добавлено: 12.01.2010 01:00:40
avis
Извините, понял свою ошибку формулировки. Моя задача: Допустим имеем фигуру - квадрат(по сути фигура абстрактна, возможно даже звезда), заданную массивом координат вершин (1-я, 2-я и т.д.). Как определить в каком направлении заданы координаты - по часовой стрелке, либо против? Сравнение координат я сразу отбросил.

Re: Подскажите геометрию, пожалуйста

Добавлено: 12.01.2010 10:28:15
AbakAngelSoft
Точно такой вопрос видел перед новым годом на delphikingdom.ru. Посмотрите - может там нашли решение.

Re: Подскажите геометрию, пожалуйста

Добавлено: 12.01.2010 16:00:23
Putnick
Простите avis, возможно, это повторный пост, но на всякий случай...

Если Вам это ещё нужно, то вот что я набросал:

Код: Выделить всё

program p7;
type
  pVertex=^TVertex;
  TVertex=record
    X, Y:real;
    Next:pVertex
  end;
var
  Vertexes, tmp:pVertex;
  v1x, v2x, v1y, v2y:real;
  Angle:real;
  State, NewState:ShortInt;

function ArcTan_2(y, x:real):Real;
var
  sign:ShortInt;
begin
  if y<0 then sign:=-1 else sign:=1;
  if x=0 then Result:=sign*pi/2 else Result:=arctan(y/x);
  if x<0 then Result:=Result+sign*pi
end;
function LoadVertexes(var Vertex:pVertex; fname:string):boolean;
var
  VertexCount, Code, p:integer;
  F:text;
  tmp, tmp1:pVertex;
  x, y:real;
  s, s1:string;
begin
  Result:=True;
  if not(FileExists(fname)) then begin
    WriteLn('Файл '+fName+' не существует');
    Result:=False;
    exit
  end;
  Assign(F, fName);
  Reset(F);
  VertexCount:=0;
  tmp1:=Vertex;
  While Not(eof(F)) do begin
    ReadLn(f,s);
    if s='' then continue;
    p:=pos(';',s);
    s1:=copy(s,1,p-1);
    Delete(s,1,p);
    Val(s1, x, Code);
    if code<>0 then begin
      WriteLn('Неверно задана переменная X');
      Close(F);
      Result:=False;
      exit
    end;
    Val(s, y, Code);
    if code<>0 then begin
      WriteLn('Неверно задана переменная Y');
      Close(F);
      Result:=False;
      exit
    end;
    if tmp1<>nil then if (tmp1^.X=X) and (tmp1^.Y=Y) then begin
      WriteLn('Две заданные подряд вершины совпадают. Поэтому вторая пропускается.');
      Continue
    end;
    inc(VertexCount);
    New(tmp);
    tmp^.X:=X;
    tmp^.Y:=y;
{    tmp^.Next:=nil;
    if Vertex=nil then Vertex:=tmp else tmp1^.Next:=tmp; // это если описываем не полигон, а ломанную линию
}
    if Vertex=Nil then begin // а это для полигона ...
      Vertex:=tmp;
      tmp^.Next:=tmp
    end else begin
      tmp1^.Next:=tmp;
      tmp^.Next:=Vertex
    end; // ... (замкнутого контура)
    tmp1:=tmp
  end;
  Close(F);
  if VertexCount<3 then begin
    WriteLn('В файле '+fName+' содержится описание менее 3 вершин');
    Result:=False;
    exit
  end else WriteLn('Из файла '+fName+' загружено описание ',VertexCount,' вершин');
end;
begin
  if not LoadVertexes(Vertexes, 'Vertexes.csv') then exit;
  tmp:=Vertexes;
  State:=0;
  Repeat  // для полигона
//  while tmp^.Next^.Next<>Nil do begin // для ломаной
    v1x:=tmp^.Next^.X-tmp^.X;
    v1y:=tmp^.Next^.Y-tmp^.Y;
    v2x:=tmp^.Next^.Next^.X-tmp^.Next^.X;
    v2y:=tmp^.Next^.Next^.Y-tmp^.Next^.Y;
    Angle:=ArcTan_2(v2y, v2x)-ArcTan_2(v1y, v1x);
    if Angle>pi then Angle:=Angle-2*pi;
    if Angle<-pi then Angle:=Angle+2*pi;
//    writeln(Angle*180/pi); // для контроля
    NewState:=0;
    if (Angle>0) and (angle<pi) then NewState:=-1;
    if (Angle<0) and (angle>-pi) then NewState:=1;
    if NewState<>0 then begin
      if State=0 then State:=NewState else if State<>NewState then begin
        State:=0;
        Break
      end;
    end;
    tmp:=tmp^.Next
  until tmp=Vertexes; // (замкнутого контура)
//  end; // линии
   if State=-1 then WriteLn('Последовательность обхода вершин - против часовой стрелки.');
   if State=0 then WriteLn('Последовательность обхода вершин - не определена.');
   if State=1 then WriteLn('Последовательность обхода вершин - по часовой стрелке.');
end.

в файле Vertexes.csv хранятся вершины (X и Y координаты через точку с запятой, по одной вершине в строчке), прмерно так:

Код: Выделить всё

1;1
0;2
1;3
2;2
1.5;1.5

Вроде работает.

С уважением, Алексей.

P.S.
В порядке прикола:

Код: Выделить всё

program p8;
type
  pVertex=^TVertex;
  TVertex=record
    X, Y:real;
    Next:pVertex
  end;
var
  Vertexes, tmp:pVertex;
  v1x, v2x, v1y, v2y:real;
  Angle:real;
  ClockWize, AntiClockWize:integer;

function ArcTan_2(y, x:real):Real;
var
  sign:ShortInt;
begin
  if y<0 then sign:=-1 else sign:=1;
  if x=0 then Result:=sign*pi/2 else Result:=arctan(y/x);
  if x<0 then Result:=Result+sign*pi
end;
function LoadVertexes(var Vertex:pVertex; fname:string):boolean;
var
  VertexCount, Code, p:integer;
  F:text;
  tmp, tmp1:pVertex;
  x, y:real;
  s, s1:string;
begin
  Result:=True;
  if not(FileExists(fname)) then begin
    WriteLn('Файл '+fName+' не существует');
    Result:=False;
    exit
  end;
  Assign(F, fName);
  Reset(F);
  VertexCount:=0;
  tmp1:=Vertex;
  While Not(eof(F)) do begin
    ReadLn(f,s);
    if s='' then continue;
    p:=pos(';',s);
    s1:=copy(s,1,p-1);
    Delete(s,1,p);
    Val(s1, x, Code);
    if code<>0 then begin
      WriteLn('Неверно задана переменная X');
      Close(F);
      Result:=False;
      exit
    end;
    Val(s, y, Code);
    if code<>0 then begin
      WriteLn('Неверно задана переменная Y');
      Close(F);
      Result:=False;
      exit
    end;
    if tmp1<>nil then if (tmp1^.X=X) and (tmp1^.Y=Y) then begin
      WriteLn('Две заданные подряд вершины совпадают. Поэтому вторая пропускается.');
      Continue
    end;
    inc(VertexCount);
    New(tmp);
    tmp^.X:=X;
    tmp^.Y:=y;
{    tmp^.Next:=nil;
    if Vertex=nil then Vertex:=tmp else tmp1^.Next:=tmp; // это если описываем не полигон, а ломанную линию
}
    if Vertex=Nil then begin // а это для полигона ...
      Vertex:=tmp;
      tmp^.Next:=tmp
    end else begin
      tmp1^.Next:=tmp;
      tmp^.Next:=Vertex
    end; // ... (замкнутого контура)
    tmp1:=tmp
  end;
  Close(F);
  if VertexCount<3 then begin
    WriteLn('В файле '+fName+' содержится описание менее 3 вершин');
    Result:=False;
    exit
  end else WriteLn('Из файла '+fName+' загружено описание ',VertexCount,' вершин');
end;
begin
  if not LoadVertexes(Vertexes, 'Vertexes.csv') then exit;
  tmp:=Vertexes;
  ClockWize:=0;
  AntiClockWize:=0;
  Repeat  // для полигона
//  while tmp^.Next^.Next<>Nil do begin // для ломаной
    v1x:=tmp^.Next^.X-tmp^.X;
    v1y:=tmp^.Next^.Y-tmp^.Y;
    v2x:=tmp^.Next^.Next^.X-tmp^.Next^.X;
    v2y:=tmp^.Next^.Next^.Y-tmp^.Next^.Y;
    Angle:=ArcTan_2(v2y, v2x)-ArcTan_2(v1y, v1x);
    if Angle>pi then Angle:=Angle-2*pi;
    if Angle<-pi then Angle:=Angle+2*pi;
//    writeln(Angle*180/pi); // для контроля
    if (Angle>0) and (angle<pi) then inc(AntiClockWize);
    if (Angle<0) and (angle>-pi) then inc(ClockWize);
    tmp:=tmp^.Next
  until tmp=Vertexes; // (замкнутого контура)
//  end; // линии
   if AntiClockWize+ClockWize>0 then WriteLn('Последовательность обхода вершин:',#10,'по часовой - ',100*ClockWize/(ClockWize+AntiClockWize),'%;',#10,'против часовой - ',100*AntiClockWize/(ClockWize+AntiClockWize),'%.')
   else WriteLn('Последовательность обхода вершин - не определена.')
end.

Re: Подскажите геометрию, пожалуйста

Добавлено: 24.01.2010 23:23:52
avis
Все оказалось гораздо проще, есть алгоритм нахождения площади со знаком произвольного многоугольника.
Пусть многоугольник задан последовательностью вершин в форме массива координат вершин: Mas: array of TPoint;
Пусть, также, координаты начало и конца ломанной совпадают. Тогда

Код: Выделить всё

Result := Result + (Mass[i+1].Y + Mass[i].Y)/2*(Mass[i+1].X-Mass[i].X)

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

В итоге получается вот такая функция:

Код: Выделить всё

//вычисление площади со знаком для произвольного многоугольника
function Square(Mass: TFigureMass): Real;
var
   i: Integer;
begin
   SetLength(Mass, Length(Mass)+1);
   Mass[High(Mass)] := Mass[0]; //начало и конец массива совпадают
   Result:=0;
   for i := 0 to Length(Mass) - 2 do
     Result := Result + (Mass[i+1].Y + Mass[i].Y)/2*(Mass[i+1].X-Mass[i].X)
end;
Часовой пояс: UTC+03:00
Страница 1 из 1

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB