Помощь студентуФайлылабы на Паскалеработа с деревьями Паскаль
23 Июня 2017, Пятница
03:04
>>> Качественная веб-разработка <<<
03:04
Меню сайта
>Г Л А В Н А Я

>Ф А Й Л Ы

>С Т А Т Ь И

>Р Е Ф Е Р А Т Ы

>Ф О Р У М

>О Т З Ы В Ы

>Т Е С Т Ы

>F l a s h И Г Р Ы

>Ф О Т О Ш О П


Советуем...
ИЗУЧЕНИЕ ЗАКОНОВ РАВНОУСКОРЕННОГО ДВИЖЕНИЯ (Машина Атвуда )
ИЗУЧЕНИЕ ЗАКОНОВ РАВНОУСКОРЕННОГО ДВИЖЕНИЯ
1. Цель работы: изучение динамики поступательного движения связанной системы тел с учетом силы трения; оценка роли трения как источника систематической погрешности при определении ускорения свободного падения на лабораторной установке.
2. Перечень приборов и принадлежностей: для выполнения данной лабораторной работы нам потребуется: установка «машина Атвуда», электронный секундомер, набор грузов массой М=0,186 кг, m=0,072 кг.
3. Материал для изучения: Уравнения динамики поступательного движения; сила трения; определение погрешностей измерений.

Работа с Турбо Паскалем #1/2
Хороший учебник по языку Паскаль. Очень много полезной информации, все описывается без лишних слов.

Вторая часть.

Примеры решений задач по теории вероятностей
В этом документе собраны Задачи и их решения по теории вероятностей по основным темам.

Сборник шпор по физике
Если Вам лень бродить по интернету или просто уже нет времени для поиска шпор по физике, то качайте этот архив. В нем Вы найдете много различных шпор, решений задач и многого другого.


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

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


код кнопки:


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


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

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

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