Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.11.26;
Скачать: CL | DM;

Вниз

У кого какие мысли?   Найти похожие ветки 

 
yuraspb ©   (2006-11-09 20:46) [0]

Что в этом коде arr_double и sgData? Ктонибудь может собрать это в прожект?

текст программы:
function Distance_Evklid(e1,e2 : arr_double) : Double;
var
 i :  Integer;
begin
 Result := 0;

 for i:=1 to High(e1) do
   Result := Result + (e1[i]-e2[i])*(e1[i]-e2[i]);
   Result := Sqrt(Result);
end;

procedure TFrmMain.Min_Matrix(var i,j : Integer ; G : Array of arr_double);
var
 k, l : Integer;
 min  : Double;
begin
min := 100;
i := 0;
j :=0;
for k := 0 to High(G) - 1 do
  for l:=i to high(G[k]) - 1 do
    if G[k,l]<>0 then
      if G[k,l]<min then
      begin
        min := G[k,l];
        i := k;
        j := l;
      end;
end;

procedure TFrmMain.N2Click(Sender: TObject);
var
 i,j,k,l : Integer;
 TmpSheet : TTabSheet;
 Grids    : Array of TStringGrid;
 Serie : TLineSeries;
 ind_1, ind_2 : Integer;
begin
 SetLength(G, sgData.RowCount);
 for i:=0 to sgData.RowCount-1 do
   SetLength(G[i], sgData.RowCount);
 SetLength(E, sgData.RowCount);
 for i:=0 to sgData.RowCount-1 do
   SetLength(E[i], sgData.RowCount);
 for i:=0 to sgData.RowCount-1 do
   for j := 0 to sgData.RowCount-1 do
     E[j,i] := StrToFloat(sgData.Cells[i,j]);
 for i:=0 to sgData.RowCount-1 do
   for j := i to sgData.RowCount-1 do
     G[i,j] := Distance_Evklid(E[i],E[j]);
 Cl_Count := 2*sgData.RowCount-1;
 SetLength(Grids,sgData.RowCount);
 SetLength(D,1);

 for i:=0 to sgData.RowCount-2 do
 begin
   TmpSheet := TTabSheet.Create(nil);
   TmpSheet.PageControl := pgc_Dist;
   TmpSheet.Caption := "&#200;&#242;&#229;&#240;&#224;&#246;&#232;&#255; "+IntToStr(i);
   Grids[i] := TStringGrid.Create(TmpSheet);
   Grids[i].Align := alClient;
   Grids[i].Visible := True;
   Grids[i].Parent := TmpSheet;
   Grids[i].FixedCols := 0;
   Grids[i].DefaultColWidth := 40;
   Grids[i].FixedRows := 0;
   Grids[i].ColCount := sgData.RowCount+i;
   Grids[i].RowCount := sgData.RowCount+i;
   for k:=0 to Grids[i].RowCount-1 do
     for l := k to Grids[i].ColCount-1 do
       Grids[i].Cells[l,k] := FloatToStrf(G[k,l],fffixed,5,3);
       Min_Matrix(ind_1,ind_2,G);
       SetLength(D,Length(D)+1);
       D[i].value := G[ind_1,ind_2];
       D[i].i := ind_1;
       D[i].j := ind_2;
       SetLength(G,Grids[i].RowCount+2);
       for k:=0 to High(G)-1 do SetLength(G[k],Grids[i].RowCount+2);
       for k:=1 to High(G)-1 do G[k,High(G[k])] := a1*G[ind_1,k]+a2*G[k,ind_2]+b*G[ind_1,ind_2]+gama*abs(G[ind_1,k]-G[k,ind_2]);
       for k:=0 to High(G[ind_1])-1 do G[ind_1][k] := 0;
       for k:=0 to High(G)-1 do G[k,ind_2] := 0;
  end;
 sgMin.ColCount :=sgData.RowCount-1;
 for k:=0 to High(G[0])-1 do sgMin.Cells[k,0] := FloatToStrf(D[k].Value,fffixed,5,3);
 for k:=0 to sgMin.ColCount do
 begin
   Serie := TLineSeries.Create(nil);
   Serie.ParentChart := chrt;
   Serie.Dark3D := true;
   chrt.Series[k].AddNullXY(D[k].i,0,"");
   chrt.Series[k].AddXY(D[k].i,0);
   chrt.Series[k].AddXY(D[k].i,D[k].Value);
   chrt.Series[k].AddXY(D[k].j,D[k].Value);
   chrt.Series[k].AddXY(D[k].j,0);
   chrt.Series[k].AddNullXY(D[k].j,0,"");
 end;
end;


 
Ketmar ©   (2006-11-09 20:58) [1]

не вижу суммы. какова оплата-то?


 
yuraspb ©   (2006-11-09 21:27) [2]

Ketmar, бесплатно.


 
Ketmar ©   (2006-11-09 21:57) [3]

тогда жди. авось кому-то настолько нечего делать будет (в чём я лично сильно сомневаюсь).


 
очевидно   (2006-11-09 22:00) [4]

arr_double = array of Double;
sgData: TStringGrid;


 
yuraspb ©   (2006-11-09 22:29) [5]

Видишь, Ketmar, не все такие, ждать пришлось не долго  )))
Спасибо Вам за ответ !


 
Горгер ©   (2006-11-10 01:40) [6]

Проанализируем код:
1) Есть матрица каких-то натуральных чисел.
2)Берем 2 вектора из этой матрицы
3) Между ними считается сумма квадратов разностей и потом из всего этого извлекаем корень.
Что это может быть?Скорее всего какая-то прога для кластерного анализа.


 
Горгер ©   (2006-11-10 01:42) [7]

> Между ними считается сумма квадратов разностей и потом из всего этого извлекаем корень.
В смысле это формула евклидового расстояния, используется в т.ч. и в кластерном анализе.  Я не утверждаю категорично


 
yuraspb ©   (2006-11-10 11:22) [8]

Горгер, Вы абсолютно правы.
А вот этот arr_double нужно прописать как type ?


 
Горгер ©   (2006-11-10 20:11) [9]

>А вот этот arr_double нужно прописать как type ?
type arr_Double = array of Double;
Вроде не ругается.


 
Anatoly Podgoretsky ©   (2006-11-10 20:17) [10]

> Горгер  (10.11.2006 20:11:09)  [9]

А с чего бы ему ругаться, если синтактически конструкция правильная.


 
MikePetrichenko ©   (2006-11-10 20:18) [11]


> тогда жди. авось кому-то настолько нечего делать будет (в
> чём я лично сильно сомневаюсь).

Сколько бездельников оказалось :)



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

Текущий архив: 2006.11.26;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.048 c
2-1162916772
Серый
2006-11-07 19:26
2006.11.26
Блокировка


2-1162938878
Ref
2006-11-08 01:34
2006.11.26
Запрос в ADOQuery


15-1163108901
KilkennyCat
2006-11-10 00:48
2006.11.26
Папуасы :)


15-1162848112
ProgRAMmer Dimonych
2006-11-07 00:21
2006.11.26
С помощью какой книги Вы научились работать с сетями из Delphi?


15-1162915760
xazan
2006-11-07 19:09
2006.11.26
Экспертные системы