Генератор перестановок (графы)
Задача в следующем.
Есть семь точек:
и код процедуры-перестановщика:
Из этих 7и точек нужно найти вершины ромба.
Как это сделать?..
Есть семь точек:
Код:
(165; 70) (415; 220) (265; 70) (265;170) (165; 220) (265; 20) (15; 20)
и код процедуры-перестановщика:
Код:
procedure GenPer(Var p:array of integer; Var g: Boolean);
Var j,m,n:integer;
begin
n:=High(p)+1;
repeat
n:=n-1;
m:=p[0];
for j:=1 to n do
p[j-1]:=p[j];
p[n]:=m;
g:=m<=n
until g or (n=1);
end;
Var j,m,n:integer;
begin
n:=High(p)+1;
repeat
n:=n-1;
m:=p[0];
for j:=1 to n do
p[j-1]:=p[j];
p[n]:=m;
g:=m<=n
until g or (n=1);
end;
Из этих 7и точек нужно найти вершины ромба.
Как это сделать?..
Я так полагаю,что оси ромба пересекаются под прямым углом.А это значит(дай Бог память точно),что какое-то произведение должно дать 0(ортогональные векторы,что ли…что-то в этом роде).В общем,надо проверять на ортогональность,так-то:)
у ромба, если что, все стороны равны (попарно).
нужно значит найти расстояния между точками, и сравнивать, мб будут 4 равных. но - такая реализация заставляет delphi падать с floating point exception.
нужно значит найти расстояния между точками, и сравнивать, мб будут 4 равных. но - такая реализация заставляет delphi падать с floating point exception.
Цитата: @pixo $oft
Я так полагаю,что оси ромба пересекаются под прямым углом.А это значит(дай Бог память точно),что какое-то произведение должно дать 0
С помощью скалярного произведения векторов, можно проверить их ортогональность.
по 4 сторонам проще
insane88:реально забыл:) Но это что,ты-то на 1м курсе,а я уже на 4м…
Да и про ортогональность я тоже ступил.Может,оси и будут ортогональны,но не по середине пересекаться,а это уже не ромб
(netlana–спасибо,напомнила;))
Точно,по сторонам.А что за код такой,что падает?
Да и про ортогональность я тоже ступил.Может,оси и будут ортогональны,но не по середине пересекаться,а это уже не ромб
(netlana–спасибо,напомнила;))
Точно,по сторонам.А что за код такой,что падает?
да я хз почему падает... компилятор в делфи какашка (
вот и хотел узнать, что и как.
суть в чем:
1. есть 2 массива с координатами по X и по Y, в них происходят одинаковые перестановки.
2. если расстояние между первыми 4мя точками одинаковое - они образуют ромб.
кода пока нет.
вот и хотел узнать, что и как.
суть в чем:
1. есть 2 массива с координатами по X и по Y, в них происходят одинаковые перестановки.
2. если расстояние между первыми 4мя точками одинаковое - они образуют ромб.
кода пока нет.
Цитата: insane88
и код процедуры-перестановщика:
Код:
procedure GenPer(Var p:array of integer; Var g: Boolean);
Var j,m,n:integer;
begin
n:=High(p)+1;
repeat
n:=n-1;
m:=p[0];
for j:=1 to n do
p[j-1]:=p[j];
p[n]:=m;
[COLOR="Red"] g:=m<=n //Зачем вы сравниваете значение индекса и значение элемента массива?[/COLOR]
until g or (n=1);
end;
Var j,m,n:integer;
begin
n:=High(p)+1;
repeat
n:=n-1;
m:=p[0];
for j:=1 to n do
p[j-1]:=p[j];
p[n]:=m;
[COLOR="Red"] g:=m<=n //Зачем вы сравниваете значение индекса и значение элемента массива?[/COLOR]
until g or (n=1);
end;
Из этих 7и точек нужно найти вершины ромба.
Как это сделать?..
Вопрос: обязательно ли использовать код этой процедуры?
Если необязательно, то есть вот такое решение:
Код:
procedure VectorLength(x:array of integer; y:array of integer);
var i,j,k,n:integer;
length: Integer;
begin
k:=0;
n:=High(x);
for i := 0 to n-1 do begin
for j := i+1 to n do begin
length := Round(sqrt(sqr(x - x [j]) + sqr(y - y [j])));
Lengths[k] := length;
k:=k+1;
end;
end;
end;
function IsRhomb(lengths:array of integer):boolean;
var i,j,n,count,value:integer;
begin
n:=High(lengths);
for j:=0 to n do begin
count := 0;
value:=lengths[j];
for i:=0 to n do begin
if(lengths=value) then count := count + 1;
end;
if(count >= 4) then begin
self.Edit1.Text := 'Нашли ромб';
result := true;
break;
end;
end;
result := false;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
self.VectorLength(ArrayOfX,ArrayOfY);
self.IsRhomb(Lengths);
end;
var i,j,k,n:integer;
length: Integer;
begin
k:=0;
n:=High(x);
for i := 0 to n-1 do begin
for j := i+1 to n do begin
length := Round(sqrt(sqr(x - x [j]) + sqr(y - y [j])));
Lengths[k] := length;
k:=k+1;
end;
end;
end;
function IsRhomb(lengths:array of integer):boolean;
var i,j,n,count,value:integer;
begin
n:=High(lengths);
for j:=0 to n do begin
count := 0;
value:=lengths[j];
for i:=0 to n do begin
if(lengths=value) then count := count + 1;
end;
if(count >= 4) then begin
self.Edit1.Text := 'Нашли ромб';
result := true;
break;
end;
end;
result := false;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
self.VectorLength(ArrayOfX,ArrayOfY);
self.IsRhomb(Lengths);
end;
Т.е. если граф является полносвязным, то сначала находим длины всех возможных векторов, а потом среди них ищем 4 равных. А с помощью, приведеной вами, процедуры перестановки вершин кажется невозможно найти все возможные комбинации вершин.
большое спасибо, такое решение должно подойти.
просто та функция из 1го поста описана в условии.
просто та функция из 1го поста описана в условии.