Помощь студентуФайлылабы на Паскалеработа с деревьями Паскаль
24 Февраля 2018, Суббота
20:49
>>> Качественная веб-разработка <<<
20:49
Меню сайта
>Г Л А В Н А Я

>Ф А Й Л Ы

>С Т А Т Ь И

>Р Е Ф Е Р А Т Ы

>Ф О Р У М

>О Т З Ы В Ы

>Т Е С Т Ы

>F l a s h И Г Р Ы

>Ф О Т О Ш О П


Советуем...
Механика, колебания и волны, молекулярная физика - Савельев И.В.
Очень хороший учебник по физике, все подробно и понятно описывается, все темы по Механике, Колебаниям и Молекулярке. Советую качать тем, кто начал учить только за день до экзамена.

Лекции и примеры программ на Паскале
В архиве документы *.doc . они содержат краткое вступление о программировании и очень много примеров готовых программ (лаб) на Паскале. В основном приводятся примеры сложных олимпиадных задач, но и в лабах могут тоже такие встречаться.

Справочник по физике
Небольшой справочник по физике. Оригинально сделан, все понятно описывается.

XVI32 2.51
Шестнадцатеричный редактор для программистов. Помимо стандартных для такого рода программ возможностей редактирования, предлагает подсчет контрольных сумм CRC16 и CRC32, поиск, замену и подсчет числа вхождений байтов в файл.


Опрос
Вы учитесь в СУЗе/ВУЗе
Всего ответов: 244

Сотрудничество
Поставьте себе на сайт и сообщите мне


код кнопки:


Связь с админом
395799449
Написать админу
Оставить отзыв


Файлы
Главная » Файлы » Учебные материалы » лабы на Паскале

работа с деревьями Паскаль

Название: работа с деревьями Паскаль
Категория: лабы на Паскале
Формат файла: *.pas
Размер: 3.5Kb
Просмотров: 4926
Загрузок: 1215
Комментариев: 1
Дата добавления: 01 Июня 2009, 12:27
Теги:готовые лабы, ссылка, деревья, ФУНКЦИИ, Паскаль, процедуры, списки, программирование, информатика, индексы
Поделиться:
Скачать:

Скачать работа с деревьями Паскаль бесплатно и без регистрации


Внимание! Если ссылка не работает, файл не найден или просто возникают какие-либо вопросы, напишите об этом, пожалуйста, мне на почту: xdypx@yandex.ru. В письме достаточно указать ссылку на эту страницу и описание проблемы или свой вопрос.


Описание:
Задание:
Дан текстовый файл с изображением целых чисел, которые переписать в стек St1. Используя стек St2, выбрать только нечетные положительные числа и построить из них сбалансированное  дерево.

Исходный код:

Program Lab12;
uses crt;
type Ptr=^Node;
     Node=record
       Dn:Integer;
       Ln,Rn:Ptr;
     end;

Type
TElement=^element;
 Element=record
 a:integer;
 next:TElement;
End;

procedure proverka(filename:string);
var f:text;
Begin
 {$I-}
  Assign(f,filename);
  reset(f);
 {$I+}
  if ioresult<>0 then Begin textcolor(204); writeln('ERROR FILE!!!'); readln; halt; End
  else writeln('fail "',filename,'" otkrit');
End;

procedure printfile(filename:string);
var f:text;
    a:string; b:integer;
 Begin
 Assign(f,filename);
 reset(f);
 while not eof(f) do
  Begin
   readln(f,a);
   writeln(a);
  End;
 close(f);
End;

procedure CreateStack(var First:TElement; x:integer);
var Q:TElement;
Begin
 new(Q);
 Q^.a:=x;
 Q^.next:=First;
 First:=q;
End;

function PrintStack(var First:TElement; var x:integer):boolean;
 var q:TElement;
  begin
    if First=nil then PrintStack:=false else
     Begin
      x:=First^.a;
      Q:=First;
      First:=First^.next;
      dispose(q);
      PrintStack:=true;
     End;
  end;


 function KolEl(var T:ptr):integer;
  begin
   if T=nil then  kolel:=0
   else kolEL:=kolel(T^.Ln)+1+kolel(T^.Rn);
  end;

 procedure AddTree(var t:Ptr; D:integer);
  begin
   if t=nil then
              begin
               new(t);
               t^.Dn:=D;
               t^.Ln:=nil;
               t^.Rn:=nil;
              end
            else if kolEL(t^.Ln)<kolEL(t^.Rn) then AddTree(t^.Ln,D)
                                          else AddTree(t^.Rn,D);
  end;


procedure PrintTree(t:Ptr; H:integer);
const M=6;
var i:integer;
 begin
  if T<>nil then
   begin
    PrintTree(t^.Ln,H+M);
    for i:=1 to H do write(' ');
    Writeln(t^.Dn);
    PrintTree(t^.Rn,H+M);
   end;
 end;

 procedure DoneTree(t:Ptr);
  begin
   if t<>nil then
              if (t^.Ln=nil) and (t^.Rn=nil) then Dispose(t)
         else
          begin
           DoneTree(t^.Ln);  t^.Ln:=nil;
           DoneTree(t^.Rn);  t^.Rn:=nil;
           Dispose(t);
          end;
  end;
 
procedure transfer(var First:TElement; filename:string);
var F:text; st,sl:string; l,code,x:integer;
Begin
 Assign(f,filename);
 reset(f);
 st:='';
 sl:='';
 while not eof(f) do
  Begin
   readln(f,st);
    for l:=1 to length(st) do
     Begin
      if st[l]<>' ' then sl:=sl+st[l] else
       Begin
        val(sl,x,code);
        CreateStack(First,x);
        sl:='';
       End;
     End;
  End;
close(F);
End;


{===========================MAIN===============================}

var  i,z,U:integer;
     t:Ptr;
     First, First2:TElement;
     
BEGIN
ClrScr;
first:=nil;
first2:=nil;
t:=nil;
i:=0;

writeln('1: BBOD 4uceJl Bpy4HyIO');
writeln('2: B39Tb 4ucJlA u3 qpauJla');
write('-->');
readln(u);
writeln;

if u=1 then
 Begin
  writeln('vvedite 4isla: ');
   readln(z);
   CreateStack(First,z);
   while z<>0 do
    Begin
     readln(z);
     CreateStack(First,z);
    End;
 End;
   
  if u=2 then
  Begin
   proverka('g:\in.txt');
   printfile('g:\in.txt');
   transfer(First,'g:\in.txt');
  End;
   writeln('sodergimoe pervogo steka: ');
   while PrintStack(First,z)<>false do
    Begin
     write(z,' ');
     if ((i mod 2<>0) and (z>0)) then CreateStack(First2,z);
     inc(i);
    End;
   writeln;
   writeln('sodergimoe vtorogo steka: ');
   while PrintStack(First2,z)<>false do Begin write(z,' '); AddTree(t,z); End;
   writeln;
   writeln('vivod dereva: ');
   writeln;
   PrintTree(t,4);
   DoneTree(t);

 readln;
End.

Комментарии:
Всего комментариев: 1
1 SkeLi   (10 Января 2010 в 22:03)
Некоторые функции неправильно написаны

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Разделы новостей
Образование [4]
лабы на Паскале [11]
Шпоры [10]
Учебники [19]
Лабы по физике [3]
Лабы по С++ [7]

Статистика

Яндекс.Метрика


Онлайн всего: 2
Гостей: 2
Пользователей: 0

Все пользователи

Яндекс цитирования Rambler's Top100 Каталог сайтов OpenLinks.RU Каталог сайтов iLinks.RU Каталог сайтов :: Развлекательный портал iTotal.RU Каталог сайтов Bi0 Каталог сайтов Всего.RU