Форум: "Начинающим";
Текущий архив: 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 := "Èòåðàöèÿ "+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