Главная страница
    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.038 c
1-1160920315
guav
2006-10-15 17:51
2006.11.26
UI: Выделение с прокруткой.


15-1162731090
Palladin
2006-11-05 15:51
2006.11.26
Аналог Орешника


3-1159078435
Urvin
2006-09-24 10:13
2006.11.26
Нет записи в бд с Firebird


2-1162963780
Marat
2006-11-08 08:29
2006.11.26
Нужна помощь


1-1160978357
id
2006-10-16 09:59
2006.11.26
XML as Registry





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