Помощь - Поиск - Пользователи - Календарь
Полная версия: ООП
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
-Катюшка-
Вот это модуль. Он должен содержать описание объекта, который представляет бинарное дерево. Объект должен обладать возможностью добавления новых элементов, удаления существующих, поиска элемента по ключу, обхода дерева а также определять число вхождений элемента Е в дерево.
unit u_lr11;

interface

type
rabotnik=record
number:integer;
FIO:string[15];
godroj:integer;
pol:char;
cem:string[12];
koldet:integer;
oklad:integer;
end;
Ptree=^Ttree;
Ttree=object
data:rabotnik;
left,right:Ptree;
function addtree(top:Ptree;newnode:rabotnik):Ptree;
procedure prosmotr(top:Ptree);
function search(top:Ptree;x:integer):boolean;
procedure Count_E(Root:Ptree;Var n:Integer;E:rabotnik);
procedure delete(var top:Ptree;node:integer);
end;
ftype=file of rabotnik;
procedure orgtree(var f:ftype;top:Ptree);

implementation

function Ttree.addtree(top:Ptree;newnode:rabotnik):Ptree;
begin
if top=nil then
begin
new(top);
top^.data:=newnode;
top^.left:=nil;
top^.right:=nil;
end
else
if top^.data.fio>newnode.fio then
top^.left:=addtree(top^.left,newnode)
else
top^.right:=addtree(top^.right,newnode);
addtree:=top
end;

procedure Ttree.prosmotr(top:Ptree);
{процедура просмотра значений узлов дерева слева направо}
begin
writeln('N ','ФИО':15,' год рожд',' пол',' семсост':12,' дети',' оклад');
if top<>nil then
begin
prosmotr(top^.left);
with top^.data do
writeln(number,' ',fio:15,' ',godroj:9,' ',pol:4,' ',cem:12,' ',koldet:5,' ',oklad:6);
prosmotr(top^.right);
end;
end;

procedure orgtree(var f:ftype;top:Ptree);
var
z:rabotnik;
begin
writeln('выполняется процедура организации дерева');
readln;
reset(f);
top:=nil;
while not eof(f) do
begin
read(f,z);
top:=top^.addtree(top,z);
end;
end;

procedure Ttree.Count_E(Root:Ptree;Var n:Integer;E:rabotnik);
Begin
If Root<>Nil then begin
With Root^.data do
If (FIO=E.FIO) then Inc(n);
Count_E(Root^.left,n,E);
Count_E(Root^.right,n,E);
end;
End;

function Ttree.search(top:Ptree;x:integer):boolean;
begin
search:=false;
while top<>nil do
if top^.data.oklad=x then
begin
search:=true;
exit;
end
else
if top^.data.oklad>x then top:=top^.left
else top:=top^.right;
end;

procedure Ttree.delete(var top:Ptree; node:integer);
var
q:Ptree;
procedure delR(var x:Ptree);
begin
if x^.right<>nil then delR(x^.right)
else begin
q^.data:=x^.data;
q:=x;
x:=x^.left;
end;
end;

begin
if top=nil then exit {элемента нет}
else if node<top^.data.oklad then delete(top^.left, node)
else if node>top^.data.oklad then delete(top^.right,node)
else begin
q:=top;
if q^.right=nil then top:=q^.left
else if q^.left=nil then top:=q^.right
else delR(q^.left);
dispose(q);
end;
end;

begin
end.

Всё компилируется, но при запуске выдаётся сообщение Cannot run a unit
Что делать?!!! Я не разбираюсь в модулях... blink.gif
А это сама программа,где я использую модуль
program lab11;
uses crt,u_lr11;
var
top,fnd,Root,addtree:PTree;
f:ftype;
nbr,n:integer;
key1,fdl,E:string;
begin
assign(f,'cotrydnik.dat');
top:=nil;
repeat
clrscr;
writeln('1-Организация дерева');
writeln('2-Просмотр дерева');
writeln('3-Добавление листа в дерево');
writeln('4-Удаление элемента из дерева');
writeln('5-Поиск в дереве по ключу');
writeln('6-Число вхождений элемента Е в дерево');
writeln('7-Выход');
writeln('--------------------------------------------------------------------------------');
writeln;
writeln('Введите номер пункта меню');
readln(nbr);
case nbr of
1:orgtree(f,top);
2:begin
writeln;
writeln('Выполняется процедура просмотра дерева');
writeln;
top^.prosmotr(top);
writeln;
readln;
end;
3:addtree:=(top,newnode);
4:begin
writeln;
writeln('Введите фамилию удаляемого элемента');
readln(fdl);
top^.delete(top,fdl);
end;
5:begin
writeln;
writeln('Введите ключевую фамилию');
readln(key1);
fnd:=top^.poisk(top,key1);
writeln;
if fnd<>nil then
writeln('Найдено')
else writeln('Не найдено');
readln;
end;
6:begin
writeln;
writeln('Введите фамилию сотрудника');
readln(E);
writeln;
n:=0;
top^.Count_E(Root,n,E);
writeln('Число сотрудников с фамилией ',E,' равно ',n);
readln;
end;
end;
until nbr=7;
end.

Это вообще не компилируется... mega_chok.gif
ПАМАГИТЕ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! wacko.gif
APAL
Судя по ошибке - ты пытаешься запустить модуль... В меню Compile в строке Distination должно стоять Disk.
После этого жмешь F9 - создается .TPU файл, т.е. сам модуль. (можно из командной строки набрать TPC.EXE <имя файла>.PAS - результат тот же)
Убедись, что модуль лежит в том же каталоге, что и файл с программой, к которой ты его подключаешь.
-Катюшка-
Цитата(APAL @ 18.05.2006 22:00) *

В меню Compile в строке Distination должно стоять Disk

Если честно, то у меня в меню Compile такого нет... Или я слепая wacko.gif
volvo
-Катюшка-, значится так... Я тут кое-что нашаманил (подправил все несоответствия, которые были в программе, и между программой и модулем). Смотри внимательно - изменений много...

Модуль:
Нажмите для просмотра прикрепленного файла
Программа:
Нажмите для просмотра прикрепленного файла

Теперь о компиляции. Скопируй и программу и модуль в одну папку, открой в TP файл программы, и нажми F9, или меню Compile -> Make... Паскаль сам откомпилирует модуль, а потом - саму программу...

Да, чуть не забыл... Поскольку у меня не было файла данных, я подставил "пустышку":
  assign(f,'employ.dat'); rewrite(f);

если у тебя есть какой-то файл, поменяй название и замени rewrite на reset, иначе содержимое файла будет удалено...

Программу тестировал на ручном вводе данных в список (меню - пункт 3). Вроде бы все работает... Единственное, что не очень красиво - просмотр дерева: строка - заголовок печатается многократно, ибо она распечатывается внутри рекурсии...
-Катюшка-
Так, уже лучше, спасибки)
Вот только у меня ошибка-- при создании дерева меня "выкидывают" из программы и пишут ошибку №100: disk read error... выбрасывают в окно с модулем на строку
procedure orgtree(var f:ftype;var top:Ptree);
var
z:rabotnik;
begin
writeln('выполняется процедура организации дерева');
readln;
reset(f);
top:=nil;
while not eof(f) do begin
read(f,z); { ==========ВОТ НА ЭТОЙ СТРОКЕ СТОИТ КУРСОР=======}
top:=top^.addtree(top,z);
end;
end;
volvo
Цитата
пишут ошибку №100: disk read error...

Похоже, что у тебя файл битый, и при попытке прочесть очередную запись программа натыкается на конец файла. Как результат - ошибка №100...
Bokul
Код

procedure orgtree(var f:ftype;var top:Ptree);
var
  z:rabotnik;
begin
  writeln('выполняется процедура организации дерева');
  readln;
  reset(f);
  seek(f,0);{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!попробуй добавить эту строку?!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  top:=nil;
  while not eof(f) do begin
    read(f,z);
    top:=top^.addtree(top,z);
  end;
end;





P.S как менять цвет текста?
-Катюшка-
Цитата(volvo @ 19.05.2006 20:23) *

Похоже, что у тебя файл битый

А что это значит? Заново что ли набирать данные в файл?
volvo
Погоди, ты что, вручную данные набирала? Файл-то типизированный... Должна программно делать это.

Прикрепила бы файл, мы бы посмотрели, может с файлом все нормально, тогда в другом месте ошибку будем искать.
-Катюшка-
Не хочет загружать этот файлик. не то разрешение, говорят( правов нетуsad.gif
Bokul
Цитата(-Катюшка- @ 19.05.2006 14:10) *

Не хочет загружать этот файлик. не то разрешение, говорят( правов нетуsad.gif

Тогда добро пожаловать на наш форум smile.gif
Зарегистрируйся. wink.gif
ПухачОк
Цитата(Bokul @ 19.05.2006 21:16) *

Тогда добро пожаловать на наш форум smile.gif
Зарегистрируйся. wink.gif

Тэкс, я зарегистрировалась, а всё равно мне пишут, что нет у меня прав для загрузки файла с таким разрешением. Разрешение dat. wacko.gif norespect.gif
volvo
Тогда в архив его, и присоединяй (rar или zip)...
Bokul
ПухачОк, а ты пробивала добавить seek (f,0) в свою процедуру( читай мои посты выше)


Цитата
Тогда в архив его, и присоединяй (rar или zip)...

А просто поменять расширения нельзя? smile.gif
ПухачОк
Вот файл(наконец-то!)

Цитата(Bokul @ 19.05.2006 22:14) *

ПухачОк, а ты пробивала добавить seek (f,0) в свою процедуру( читай мои посты выше)

Нет, не пашет... YYY.gif
volvo
Файл битый однозначно. Прошел по программе в пошаговом режиме: нормально прочиталась только первая запись. Вторая уже содержит какой-то мусор...

Придется файл создавать заново.

И еще одно. Скажи мне, как по-твоему, при размере записи в 38 байт размер файла равен 287 байт - это нормально? Так сколько записей содержит файл? smile.gif
ПухачОк
Цитата(volvo @ 19.05.2006 21:41) *

Придется файл создавать заново.

Создала новый файл. Он, урод, тоже какой-то дурацкий... Всё равно выдаёт ту же ошибку...
Получается, этот файл с данными сразу становиться битым... А почему-- я не знаю((( ypriamii.gif
volvo
Показывай код, которым создаешь файл, может там что-то не так?
ПухачОк
Там вроде правильно...Если это вообще то, что надо)
volvo
Ну, ПухачОк, надо же быть внимательнее!!!
Это описание типа из модуля u_lr11:
 rabotnik=record
number:integer;
FIO:string[15];
godroj:integer;
pol:char;
cem:string[12]; // <--- Запомни это число: 12 !!!
koldet:integer;
oklad:integer;
end;

а вот это - в программе генерации DAT - файла:
 rabotnik=record
number:integer;
FIO:string[15];
godroj:integer;
pol:char;
cem:string[15]; // <--- Ничего странного не видишь?
koldet:integer;
oklad:integer;
end;


Вот тебе и результат: длина файла, созданного твоей программой не совпадает с длиной, которую ожидает модуль при чтении в список. Так что, см. сообщение №6 smile.gif

Чтобы поправить ситуацию - просто замени в модуле u_lr11 то самое число 12 на 15, и будешь работать с файлами, как положено...
ПухачОк
Эхъ, я дусяк!)))) пасибо огромное!!! !mol1.gif
ПухачОк
Блина!!!! Не пашут мои процедурки поиска и количества эл-тов Е!!! norespect.gif
В чём дело????!!!!!
volvo
Цитата(ПухачОк @ 20.05.2006 20:25)
Блина!!!! Не пашут мои процедурки поиска и количества эл-тов Е!!!
В чём дело????!!!!!

С Count_E все просто - не тот параметр передается в процедуру. Измени вызов на такой:
    top^.Count_E(Top, n, newnode); { <--- Top вместо Root }

а вот с Search все гораздо хуже... Search ищет узел в дереве, согласно ключу. И, заметь, согласно тому же ключу, по которому дерево строится. Дерево, насколько я вижу из AddTree, строится с ключом "FIO", как же ты хочешь искать узел по значению "oklad"? Максимум что можно будет сделать - это переписать поиск на "поиск по фамилии" (ну, или изменить AddTree так, чтобы дерево создавалось с другим ключом)... Выбирай smile.gif
ПухачОк
Тэкс, ща попытаюсь переделать, можить даже получится...
ПухачОк
УУУУУУУУУРРРРРРРРРРАААААААААА!!!!!!!!!!!!!
ПОЛУЧИЛОСЬ!!! Вы все гении!!!!!!)))
вот прога работающая!!!!!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.