IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Построение оптимального дерева бинарного поиска!
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 80
Пол: Мужской

Репутация: -  0  +


Тема: построение оптимального дерева бинарного поиска.

Дерево у меня строится, строится график эффективности алгоритма, а вот с выводом дерева трудности! Может кто-нибудь подскажет, как правильно его реализовать с помощью TTreeView... Помогите, пожалуста, вот текст программы и в архиве сама программа.



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart;

type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Panel2: TPanel;
Chart1: TChart;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
Series1: TLineSeries;
Series2: TLineSeries;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

tTree = ^tNode;
tNode = record
data : string[5];
left : tTree;
right : tTree;
end;

const
nabsmax = 999;
bd = 1000000;
var
Form1: TForm1;
A : array [1..nabsmax] of string[5];
B : array [0..nabsmax] of string[5];
P : array [1..nabsmax] of integer;
Q : array [0..nabsmax] of integer;
W,C : array [0..nabsmax,0..nabsmax] of integer;
R : array [0..nabsmax,0..nabsmax] of string[5];

implementation

{$R *.dfm}

procedure BuildTree(var root : ttree; y,z : integer);
var
c : integer;
d : string[5];
begin
new(root);
d := R[y,z];
root^.data := d;
root^.left := nil;
root^.right := nil;
delete(d,1,1);
c := StrToInt(d);
if y <> z
then
begin
BuildTree(root^.left,y,c-1);
BuildTree(root^.right,c,z);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,j,m,k,x,Cij,n,nmax,rand,count : integer;
tree : ttree;
begin
nmax := StrToInt(self.LabeledEdit1.Text); // считали количество проходок
rand := StrToInt(self.LabeledEdit2.Text); // считали рандом для частот
randomize;
for n := 1 to nmax do // запускаем цикл для изменяющегося количества элементов
begin
Fillchar(W,sizeof(W),0); // обнуляем
Fillchar(C,sizeof©,0); // все
Fillchar(R,sizeof®,' '); // исходные
Fillchar(A,sizeof(A),' '); // массивы
Fillchar(B,sizeof(B),' '); // данных
for i := 1 to n do // забиваем массив A
A[i] := 'a' + IntToStr(i);
for i := 0 to n do // забиваем массив B
B[i] := 'b' + IntToStr(i);
for i := 1 to n do
P[i] := random(rand) + 1;
for i := 0 to n do
Q[i] := random(rand) +1;
count := 0;
for i := 0 to n do
begin
W[i,i] := Q[i];
C[i,i] := 0;
R[i,i] := B[i];
end;
for m := 1 to n do
begin
for i := 0 to n-m do
begin
j := i + m;
W[i,j] := W[i,j-1] + P[j] + Q[i];
Cij := bd;
for k := i+1 to j do
begin
if Cij > (W[i,j] + C[i,k-1] + C[k,j])
then
begin
inc(count);
Cij := W[i,j] + C[i,k-1] + C[k,j];
x := k;
end;
end;
C[i,j] := Cij;
r[i,j] := A[x];
end;
end;
self.Series1.AddXY(n,count*ln(sqrt(count)));
self.Series2.AddXY(n,n*n*n);
new(tree);
BuildTree(tree,0,n);
tree^.left := nil;
tree^.right := nil;
dispose(tree);
end;
end;

end.


Прикрепленные файлы
Прикрепленный файл  lab_3.rar ( 235.71 килобайт ) Кол-во скачиваний: 128
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Это теперь так принято, выкладывать в тексте одну версию программы, а в архиве - другую? Чтоб нам тут было чем заняться, и повосстанавливать в точности все, что ты имел в виду в ТРЕТЬЕЙ версии, с которой ты работал, да? Где в архиве у тебя BuildTree? Что вообще делает та программа, которую ты прилепил? Она ж не строит ничего...

Зато EXE-шник свой со всеми временными файлами ты заставляешь скачивать... Зачем оно надо, не расскажешь? Четверть мегабайта траффика - коту под хвост. Лучше бы выложил окончательную версию кода...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 80
Пол: Мужской

Репутация: -  0  +


Извини пожалуйста, очень невнимательный ... Хотя разницы между этими программами почти нету ... Если не сложно, посмотри эту версию (она выложена кодом выше), TTreeView - везде написано, что не сложно сделать, а на деле что-то не то ...



Прикрепленные файлы
Прикрепленный файл  laba_3.rar ( 10.08 килобайт ) Кол-во скачиваний: 93
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






А теперь внимание - вопрос. Ты написал, что
Цитата
Дерево у меня строится, строится график эффективности алгоритма, а вот с выводом дерева трудности!
Ты уверен в этом? Уверен, что ты не пытаешься построить дерево, а действительно его строишь, причем строишь правильно? Тогда еще один вопрос: а что дерево содержит, и КАК обращаться к нему, если ты зачем-то удаляешь на каждой итерации корень дерева. Это у тебя получается игра "кто больше впустую израсходует памяти".

Ну, если ты так уверен, что дерево строится - отображай его:
procedure TreeToView(parentNode: TTreeNode;
T: ttree; TV: TTreeView);
var newNode: TTreeNode;
begin
if T = nil then exit;
newNode := TV.Items.AddChild(parentNode, t.data);
TreeToView(newNode, T.left, TV);
TreeToView(newNode, T.right, TV);
end;
Передавай первым параметром nil, вторым - указатель на дерево, и третьим - собственно TreeView, куда выводить дерево. Посмотрим, что у тебя получится... Откуда вызывать это все - решать тебе, я логику работы твоей программы не понимаю.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Пионер
**

Группа: Пользователи
Сообщений: 80
Пол: Мужской

Репутация: -  0  +


Спасибо, твоя подсказка принесла НЕКОТОРЫЕ плоды ... но пока не те, что нужны! Каждый раз удалять корень необходимо, потому что мне нужно было сделать оценку эффективности, а для этого нужно оценить эффективность n раз (например 100 элементов, и начиная с 1 до 100 для каждого случая строить дерево и считать количество итераций). А вывести дерево можно 1 раз (только для того, чтобы показать, что я это могу smile.gif). То есть после прохода по циклам нужно вывести последнее полученное дерево. Вроде бы программа что-то пытается вывести, но, непонятно что. Не знаешь в чем ошибка?

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Panel2: TPanel;
Chart1: TChart;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
Series1: TLineSeries;
Series2: TLineSeries;
TreeView1: TTreeView;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

tTree = ^tNode;
tNode = record
data : string[5];
left : tTree;
right : tTree;
end;

const
nabsmax = 999;
bd = 1000000;
var
Form1: TForm1;
A : array [1..nabsmax] of string[5];
B : array [0..nabsmax] of string[5];
P : array [1..nabsmax] of integer;
Q : array [0..nabsmax] of integer;
W,C : array [0..nabsmax,0..nabsmax] of integer;
R : array [0..nabsmax,0..nabsmax] of string[5];
T:Ttree;

implementation

{$R *.dfm}

procedure TreeToView(parentNode: TTreeNode;
T: ttree; TV: TTreeView);
var newNode: TTreeNode;
begin
if T = nil then exit;
newNode := TV.Items.AddChild(parentNode, t.data);
TreeToView(newNode, T.left, TV);
TreeToView(newNode, T.right, TV);
end;

procedure BuildTree(var root : ttree; y,z : integer);
var
c : integer;
d : string[5];
begin
new(root);
d := R[y,z];
root^.data := d;
root^.left := nil;
root^.right := nil;
delete(d,1,1);
c := StrToInt(d);
if y <> z
then
begin
BuildTree(root^.left,y,c-1);
BuildTree(root^.right,c,z);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,j,m,k,x,Cij,n,nmax,rand,count : integer;
tree : ttree;
begin
nmax := StrToInt(self.LabeledEdit1.Text); // считали количество проходок
rand := StrToInt(self.LabeledEdit2.Text); // считали рандом для частот
randomize;
for n := 1 to nmax do // запускаем цикл для изменяющегося количества элементов
begin
Fillchar(W,sizeof(W),0); // обнуляем
Fillchar(C,sizeof©,0); // все
Fillchar(R,sizeof®,' '); // исходные
Fillchar(A,sizeof(A),' '); // массивы
Fillchar(B,sizeof(B),' '); // данных
for i := 1 to n do // забиваем массив A
A[i] := 'a' + IntToStr(i);
for i := 0 to n do // забиваем массив B
B[i] := 'b' + IntToStr(i);
for i := 1 to n do
P[i] := random(rand) + 1;
for i := 0 to n do
Q[i] := random(rand) +1;
count := 0;
for i := 0 to n do
begin
W[i,i] := Q[i];
C[i,i] := 0;
R[i,i] := B[i];
end;
for m := 1 to n do
begin
for i := 0 to n-m do
begin
j := i + m;
W[i,j] := W[i,j-1] + P[j] + Q[i];
Cij := bd;
for k := i+1 to j do
begin
if Cij > (W[i,j] + C[i,k-1] + C[k,j])
then
begin
inc(count);
Cij := W[i,j] + C[i,k-1] + C[k,j];
x := k;
end;
end;
C[i,j] := Cij;
r[i,j] := A[x];
end;
end;
self.Series1.AddXY(n,count*ln(sqrt(count)));
self.Series2.AddXY(n,n*n*n);
new(tree);
BuildTree(tree,0,n);
tree^.left := nil;
tree^.right := nil;
dispose(tree);
end;
TreeToView(nil, Tree, TreeView1);
end;

end.


Прикрепленные файлы
Прикрепленный файл  lab_3.rar ( 10.79 килобайт ) Кол-во скачиваний: 105
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Хм... Странно. Что-то глючит реализация Items.AddChild по-моему, лезет не туда, куда ей вообще надо лезть, и портит память. Если ДО нее T.left = nil, то после - откуда-то T.left = $3, и вылет с исключением EAccessViolation... Вот так - работает стабильно:
procedure TreeToView(parentNode: TTreeNode;
T: ttree; TV: TTreeView);
var
newNode: TTreeNode;
L, R: TTree;
begin
if T = nil then exit;
L := T.left; R := T.right; // Запоминаем значения Left/Right ПЕРЕД вызовом Items.Add
newNode := TV.Items.AddChild(parentNode, T.data);
TreeToView(newNode, L, TV);
TreeToView(newNode, R, TV);
end;
В результате ты получаешь в TreeView1 единственный элемент, на который указывает tree. А что ты хотел, ты ж
  BuildTree(tree,0,n);
tree^.left := nil; // и левую ветку
tree^.right := nil; // и правую тоже
просто берешь и отсекаешь, указатели-то теряются... И дерево превращается в один единственный элемент, хотя память по прежнему занята.

Теперь понятнее стало, почему я говорил,
Цитата
Это у тебя получается игра "кто больше впустую израсходует памяти".
?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 80
Пол: Мужской

Репутация: -  0  +


Да, понял, спасибо большое! Указатели уже много крови попили! Все время с ними какие-то проблемы, хотя в большинстве случаев по моей же глупости ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 7:48
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name