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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Деревья, нужно построить
сообщение
Сообщение #1


Бывалый
***

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

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


Здравствуйте товарищи программисты.

Дан список.Необходимо сформировать бинарное дерево, упорядоченное по возрасту, вывести инфу о клиентах старше указанного возраста. (список клиентов клиники : город, диагноз, возраст)
Код
program spisok_patientov;
{$D+,L+}
uses crt;
type pat=record
     n:integer;
     c,d,fam:string[25];
     end;
     patptr=^patdin;
     patdin=record
     dat:pat;
     next:patptr;
     end;
var fpat:file of pat;
    first:patptr;
    st:pat;
Procedure Createfile; {ᮧ¤ ­ЁҐ д ©« }
var sym:char;
    i:integer;
begin
clrscr;
rewrite(fpat);
repeat
   with st do
    begin
      write('‚®§а бв - ');
      readln(n);
      write('” ¬Ё«Ёп - ');
      readln(fam);
      write('„Ё Ј­®§ - ');
      readln(d);
       write('ѓ®а®¤ - ');
      readln(c);
      end;
  write(fpat,st);
  write('Џа®¤®«¦Ёвм ? [„/Ќ]');
  readln(sym);
until sym in ['­','Ќ'];
close(fpat);
end;

Procedure List_Create(var first:patptr); {ᮧ¤ ­ЁҐ ­Ґ®вб®авЁа®ў ­­®Ј® бЇЁбЄ 
б ¤®Ў ў«Ґ­ЁҐ¬ н«Ґ¬Ґ­в®ў ў Є®­Ґж бЇЁбЄ }
var tek,last:patptr;
begin
reset(fpat);
first:=nil;
last:=nil;
while not(eof(fpat)) do
begin
  new(tek);         {ўл¤Ґ«Ґ­ЁҐ Ї ¬пвЁ}
  read(fpat,tek^.dat);
  {з⥭ЁҐ Ё­д®а¬ жЁЁ Ё§ д ©«  Ё а §¬ҐйҐ­ЁҐ ҐҐ ў Ї®«Ґ dat н«-в  бЇЁбЄ }
  tek^.next:=nil;
  if first=nil
     then first:=tek
      else last^.next:=tek;
  last:=tek;
  end;
end;

Procedure Sort_List_Create(var first:patptr);
{ᮧ¤ ­ЁҐ ®б®авЁа бЇЁбЄ }
var tek,tek1,pred:patptr;
begin
  reset(fpat);
  first:=nil;
  while not(eof(fpat)) do
   begin
     new(tek);           {ўл¤Ґ«Ґ­ЁҐ Ї ¬пвЁ}
     read(fpat,tek^.dat);
     tek^.next:=nil;
     if first=nil
       then first:=tek
    else
     begin
     tek1:=first; {Ї®ЁбЄ ¬Ґбв  ¤«п ўбв ўЄЁ}
     pred:=nil;
     while (tek1<>nil) and
           (tek^.dat.fam>tek1^.dat.fam) do
           begin
        pred:=tek1;
        tek1:=tek1^.next;
           end;
     if tek1=first then {ўбв ўЄ  ў ­ з «®}
       begin
        tek^.next:=first;
        first:=tek;
       end
     else           {ўбв ўЄ  Ї®б«Ґ pred}
      begin
       tek^.next:=pred^.next;
       pred^.next:=tek;
      end;
       end;
     end;
  end;

Procedure Print(first:patptr);   {Їа®жҐ¤га  ўлў®¤  бЇЁбЄ  ­  нЄа ­}
var i:integer;
     tek:patptr;
begin
  clrscr;
  tek:=first;
  while tek<>nil do
   begin
    with tek^.dat do
     begin
      write(n:3,'   ',fam,'   ':20-length(fam),'  ',d:15,'   ',c);
       writeln;
      end;
    tek:=tek^.next                 {ЇҐаҐе®¤ Є б«Ґ¤ н«Ґ¬Ґ­вг}
    end;
    writeln;
    writeln('Ќ ¦¬ЁвҐ ENTER');
    readln;
  end;

Procedure DeleteList(var first:patptr);
{г¤ «Ґ­ЁҐ бЇЁбЄ }
var tek:patptr;
begin
while first<>nil do
begin
   tek:=first;
   first:=first^.next;
   dispose(tek);
end;
end;
Procedure Del(var first:patptr);  {“¤ «Ґ­ЁҐ н«Ґ¬Ґ­в }
var fam:string;
tek,pred:patptr;
begin
writeln('‚ўҐ¤ЁвҐ ” ¬Ё«Ёо ¤«п г¤ «Ґ­Ёп');
readln(fam);
tek:=first;
while tek<>nil do
  if tek^.dat.fam=fam then
   begin
    if tek=first
     then first:=tek^.next
      else pred^.next:=tek^.next;
      dispose(tek);
      exit
     end
   else begin
       pred:=tek;
       tek:=tek^.next
   end;
  writeln('” ¬Ё«Ёп ',fam,' ­Ґ ­ ©¤Ґ­ ');
  end;
  begin
    assign(fpat,'pat.dat');
    {$I-}
    reset(fpat);
     {$I+}
    if IOresult<>0 then
    Createfile;
    List_Create(first);
    writeln('*************************************');
    writeln('       Ќ…Ћ’‘Ћђ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ      ');
    print(first);
    writeln('*************************************');
    deletelist(first);
    Sort_List_Create(first);
    writeln('*************************************');
    writeln('       Ћ’‘Ћђ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ        ');
    print(first);
    writeln('*************************************');
    del(first);
    writeln('*************************************');
    writeln('       Ћ’ЉЋђђ…Љ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ     ');
    print(first);
    writeln('*************************************');
    deletelist(first);
end.


Извините русские буквы не отображаются

Как строить это самое дерево.
Помогите пожалуйста с написание программы.

Сообщение отредактировано: cooler -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

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


Бинарные деревья


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(cooler @ 16.05.2007 19:56) *

Извините русские буквы не отображаются

Правильнее было бы сказать не "не отображаются", а "не отображаю".
Если бы уважал собеседников, переконвертил бы досовскую кодировку в виндусовую..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

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

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


Русские фразы не столь важны
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
***

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

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


мисс_граффити, в этом разделе в некоторых процедурах не совпадает число указ. переменных и число переменных при обращении к процедуре.
Как это исправить?
Тут же нет того, как сделать бинарное дерево, упорядоченное по возрасту,как вывести информ. о клиентах старше указанного возраста.

Может ли кто-нибудь помочь с написанием нормальной, работающей программы, ато отдельно по процедурам я её никак не соберу.Может кто делал такую???!!??
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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


Бывалый
***

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

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


Sorry. Все правильно.
Что такое FINDNODE ???
В модуле нет и в проге не прописано.

Как упорядочить по возрасту?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Цитата
Что такое FINDNODE ???
В модуле нет и в проге не прописано.
Поменяй все FindNode на Find (просто раньше сама функция называлась FindNode, потом я ее переименовал, а исправить в описании забыл. Сейчас поправлю). Бери саму функцию из присоединенного файла.
 К началу страницы 
+ Ответить 

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

 





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