работа с деревьями Паскаль - лабы на Паскале - Файлы - Помощь студенту
Помощь студентуФайлылабы на Паскалеработа с деревьями Паскаль
11 Декабря 2016, Воскресенье
14:54
>>> Качественная веб-разработка <<<
14:54
Меню сайта
>Г Л А В Н А Я

>Ф А Й Л Ы

>С Т А Т Ь И

>Р Е Ф Е Р А Т Ы

>Ф О Р У М

>О Т З Ы В Ы

>Т Е С Т Ы

>F l a s h И Г Р Ы

>Ф О Т О Ш О П


Советуем...
кряк и русификатор к CrazyTalk 4.5, CrazyTalk 5, CrazyTalk 6.1
кряк и русификатор к  CrazyTalk 4.5, CrazyTalk 5, CrazyTalk 6.1

работа с графикой и формами Delphi
Построить по заданным значениям 2 треугольника (простой и прямоугольный) и определить, сколько точек лежат в месте пересечения этих треугольников и значение этой площади. С клавиатуры вводятся параметры:
 - Координаты вершин обычного треугольника А, В, С;
 - Координату вершины прямоугольного треугольника А;
 - Длины сторон прямоугольного треугольника;
 - Количество построенных на экране точек и их цвет;

Ссылка открывается в новом красивом окне (highslide)
У меня на сайте я сделал так, чтобы при нажатии на Регистрация (в блоке "Пользователь" справа) страница регистрации появляется в новом красивом окошке. В этом окне можно выводить любую информацию.

Работа с двоичными файлами и массивами с++
Создать двоичный файл и записать в него n целых чисел. Из файла сформировать массив, записав в него только кратные M значения, расположенные до минимального элемента в файле.


Опрос
Вы учитесь в ...
Всего ответов: 650

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


код кнопки:


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


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

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

Название: работа с деревьями Паскаль
Категория: лабы на Паскале
Формат файла: *.pas
Размер: 3.5Kb
Просмотров: 4332
Загрузок: 1035
Комментариев: 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]

Статистика

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


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

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

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