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

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.092 c
2-1162748719
100%
2006-11-05 20:45
2006.11.26
with


4-1152770235
тт
2006-07-13 09:57
2006.11.26
Как узнать серийный номер HDD в Win2000, не имея прав админа?


15-1162621824
oleg_petrenko77@mail.ru
2006-11-04 09:30
2006.11.26
Просьба помочь


3-1158907906
Ольга
2006-09-22 10:51
2006.11.26
Как заставить SUM обрабатывать NULL


2-1162926039
ils
2006-11-07 22:00
2006.11.26
Подскажите, как красивее реализовать проход по периоду





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский