Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Вниз

Помогите составить кодик   Найти похожие ветки 

 
Erick ©   (2005-05-26 00:00) [0]

Вообще ситуация в следующем. Немного об алгоритме. Это алгоритм максимина.
Даны точки с координатами x,y,z. Прорисовка проходит на плоскости, поэтому для рисования третью координату мы отбрасываем, но при всех вычислениях учитываем все координаты. Сначала, произвольным образов выбираем любую точку. Она будет ядром N1 порвого класса. Затем вычисляем расстояние от этой точки до всех остальных, и выбираем точку с максимальным расстоянием до первого ядра. Это будет ядро N2 класса. Затем вычисляем расстояния от этих ядер до остальных точек. Находим среди них минимальные. Т.о. у нас два min. Среди них выбираем максимальное. Теперь, если это расстояние больше чем половина расстояния между N1 и N2, то эта точка будет ядром N3 класса 3. Если меньше, то она будет пренадлежать к тому классу, с ядром которого у неё был min. Т.е. сравнивем с 1/2d, где d-расстояние между первым и вторым ядром. И т.д.
Потом сравниваем с 1/2d1+1/2d2 делить всё на 2 и т.д.

Думаю понятно. Алгоритм заканчивается, когда количество классов перестаёт изменятся.  Вообще вроде, учитывая алгоритм, должно быть не более двух классов, остальные точки будут их ядрами.
Значит ядра, принадлежащие к одному классу у меня помечаются одним цветом. Но проблема у меня в кодике. Значит два ядра я нашёл, но дальше не могу дадуматься как автоматизировать поиск отальных ядер.:wall: Еслибы изначально было извесно количество точек, то можно было бы сделать и вручную.:) Но, т.к. их количество заранее не извесно, то,   :wall:
Вообщем вот кодик:

procedure TForm1.Button2Click(Sender: TObject);
var
i,j,number,number1,number2:integer;
d,max,min1,min2,min:extended;
kernel_mas:array [1..100] of integer;
x,y,rd:integer;
color_mas:array [1..5] of TColor;
begin
color_mas[1]:=clRed;
color_mas[2]:=clBlue;
color_mas[3]:=clGreen;
color_mas[4]:=clYellow;
color_mas[5]:=clBlack;
{x:=StrToInt(StringGrid1.Cells[1,1]);
y:=StrToInt(StringGrid1.Cells[2,1]); }
for j:=1 to vcount do begin
x:=StrToInt(StringGrid1.Cells[1,j]);
y:=StrToInt(StringGrid1.Cells[2,j]);
Image1.Canvas.Ellipse(x-5,y-5,x+5,y+5);
Image1.Canvas.TextOut(x+5,y+5,IntToStr(j));
end;
Randomize;
j:=random(vcount);
x:=StrToInt(StringGrid1.Cells[1,j]);
y:=StrToInt(StringGrid1.Cells[2,j]);
Image1.Canvas.Brush.Color:=color_mas[1];
Image1.Canvas.Ellipse(x-5,y-5,x+5,y+5);

max:=0;
//Memo1.Lines.Add("N1=X(1)");
//вычисляем расстояния от первого ядра до остальных объектов. N2-оъект с мах
//расстоянием до первого ядра.
for i:=1 to vcount do
begin
d:=evclid(j,i);
if d>max then begin
max:=d;
number:=i;
end;
end;
x:=StrToInt(StringGrid1.Cells[1,number]);
y:=StrToInt(StringGrid1.Cells[2,number]);
Image1.Canvas.Brush.Color:=color_mas[2];
Image1.Canvas.Ellipse(x-5,y-5,x+5,y+5);

kernel_mas[1]:=j;
kernel_mas[2]:=number;
{Вычисляются расстояния между остальными точками
и имеющимися ядрами}
{min1:=1000;
min2:=1000;
for i:=2 to vcount do begin
if (i<>kernel_mas[2]) then begin
d:=evclid(kernel_mas[1],i);
if d<min1 then begin
min1:=d;
number1:=i;
end;
end;
end;

for i:=2 to vcount do begin
if (i<>kernel_mas[2]) then begin
d:=evclid(kernel_mas[2],i);
if d<min2 then begin
min2:=d;
number2:=i;
end;
end;
end;
if min1>min2 then begin
//Memo1.Lines.Add("Bkp="+FloatToStr(min1));
if (min1>evclid(kernel_mas[1],kernel_mas[2])/2) then begin
//Memo1.Lines.Add("N3=X("+IntToStr(number1)+")");
kernel_mas[3]:=number1;
end;
end
else begin
//Memo1.Lines.Add("Bkp="+FloatToStr(min2));
if (min2>evclid(kernel_mas[1],kernel_mas[2])/2) then begin
//Memo1.Lines.Add("N3=X("+IntToStr(number2)+")");
kernel_mas[3]:=number2;
end;

end;

           }
end;

И код функции evclid, которая вычисляет расстояние между двумя точками:

function evclid(i:integer;j:integer):extended;
var
k,rez,_sqr:integer;
begin
rez:=0;
for k:=1 to 3 do
begin
_sqr:=sqr(StrToInt(Form1.StringGrid1.Cells[k,i])-StrToInt(Form1.StringGrid1.Cells[k,j]));
rez:=rez+_sqr;
end;

evclid:=sqrt(rez);
end;

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


 
yk ©   (2005-05-26 09:32) [1]


> Еслибы изначально было извесно количество точек, то можно
> было бы сделать и вручную.:)


Поэтому ты берёшь
kernel_mas:array [1..100] of integer;  ???

Используй динамические массивы

kernel_mas:array  of integer;

.....
SetLength(kernel_mas,количество_точек)

А вообще мне читать лень код:
Как у тебя помечается, какая точка какому классу принадлежит?
(По-моему никак :) )
Почитай про структуры и используй их - всё у тебя получится !


 
Andarko ©   (2005-05-26 09:49) [2]

С утра нечкго делать - вот для двухядерного случая

function evclid(i:integer;j:integer):extended;
var
 k,rez,_sqr:integer;
begin
 rez:=0;
 for k:=1 to 3 do
 begin
   _sqr:=sqr(StrToInt(Form1.StringGrid1.Cells[k,i])-StrToInt(Form1.StringGrid1.Cells[k,j]));
   rez:=rez+_sqr;
 end;
 evclid:=sqrt(rez);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i,j,number,number1,number2:integer;
d,d1,d2,d_max,min1,min2,min:extended;
kernel_mas:array [1..100] of integer;
M_Min:array of Integer;
Jadro1,Jadro2:integer;

x,y,rd:integer;
color_mas:array of TColor;
MT:array of TPoint;//? ????? ????? ???????? ? ????????, ??? ?? StringGrid
begin
 SetLength(color_mas,3);
 color_mas[1]:=clRed;
 color_mas[2]:=clBlue;
 FillChar(kernel_mas,sizeof(kernel_mas),0);

 vCount:=StringGrid1.RowCount-1;
//vcount - число точек?
//kernel_mas - массив принадлежности ядру?
//Color_mas - цвет ядер?
//Вобще, если киаешь такой КОДИК, то подписывай побольше.
//В таком коде разбираться никому неохота ;)
 SetLength(MT,VCount+1);
 for i:=1 to VCount do
 begin
   MT[i].X:=StrToInt(StringGrid1.Cells[1,i]);
   MT[i].Y:=StrToInt(StringGrid1.Cells[2,i]);
 end;
 randomize;

//Брем произвольный элемент первым ядром
 Jadro1:=random(VCount)+1;
 Image1.Canvas.Brush.Color:=color_mas[1];
 Image1.Canvas.Ellipse(MT[Jadro1].X-5,MT[Jadro1].Y-5,
 MT[Jadro1].X+5,MT[Jadro1].Y-5+5);
 Image1.Canvas.TextOut(MT[Jadro1].X+5,MT[Jadro1].Y-5,
 IntToStr(Jadro1));
 kernel_mas[Jadro1]:=1;

 SetLength(M_Min,VCount+1);
 d_max:=0;
 for i:=1 to VCount do
   if kernel_mas[i]=0 then
   begin
     d:=evclid(Jadro1,i);
     if d_max<d then
     begin
       Jadro2:=i;
       d_max:=d;
     end;
   end;
 Image1.Canvas.Brush.Color:=color_mas[2];
 Image1.Canvas.Ellipse(MT[Jadro2].X-5,MT[Jadro2].Y-5,MT[Jadro2].X+5,MT[Jadro2].Y-5+5);
 Image1.Canvas.TextOut(MT[Jadro2].X+5,MT[Jadro2].Y-5,IntToStr(Jadro2));
 kernel_mas[Jadro2]:=1;

 for i:=1 to VCount do
 begin
   if kernel_mas[i]=0 then
   begin
     d1:=evclid(Jadro1,i);
     d2:=evclid(Jadro2,i);
     if d1<d2 then
     begin
       d:=d1;
       number:=i;
       number1:=1;
     end
     else
     begin
       d:=d2;
       number:=i;
       number1:=2;
     end;
     Image1.Canvas.Brush.Color:=color_mas[number1];
     Image1.Canvas.Ellipse(MT[number].X-5,MT[number].Y-5,MT[number].X+5,MT[number].Y-5+5);
     Image1.Canvas.TextOut(MT[number].X+5,MT[number].Y-5,IntToStr(number));
     kernel_mas[number]:=1;
   end;

 end;
end;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.05 c
9-1110527050
Xenon
2005-03-11 10:44
2005.06.14
Зацените скрины


1-1117211366
Shmit
2005-05-27 20:29
2005.06.14
Kak sdelat formu always on a top?


4-1113589617
ComPort
2005-04-15 22:26
2005.06.14
Срочно нужна помощь, трабла с COM портом...


14-1117002765
Гаврила
2005-05-25 10:32
2005.06.14
Automatic Delphi 7 Code Completion


1-1115828348
Dr. Genius
2005-05-11 20:19
2005.06.14
Эмуляция нажатия комбинаций клавиш





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский