Помощь студентуФайлылабы на Паскалеработа с деревьями Паскаль
26 Декабря 2024, Четверг
15:24
>>> Качественная веб-разработка <<<
15:24
Меню сайта
>Г Л А В Н А Я

>Ф А Й Л Ы

>С Т А Т Ь И

>Р Е Ф Е Р А Т Ы

>Ф О Р У М

>О Т З Ы В Ы

>Т Е С Т Ы

>F l a s h И Г Р Ы

>Ф О Т О Ш О П


Советуем...
Программа решает СЛУ методом Гаусса
Очень хорошая программа для решения Систем Линейных Уравнений методом Гаусса. Выводится подробный ответ, по действиям. Приводит к ступенчатому виду.

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

работа со списками Паскаль
Задание:
Имеется файл. Содержимое файла поместить в список в обратном порядке.

Пример:
содержимое файла: 123456789
полученный список: 987654321

Infinity 1.2.6
Infinity 1.2.6 - программа для решения систем дифференциальных и алгебраических уравнений. C помощью Infinity вы сможете решить такие задачи, которые не по зубам ни Maple, ни MatLab, ни тем более MathCad.
Отличия метода решения систем нелинейных обыкновенных дифференциальных уравнений, реализованного в Infinity, от методов реализованных в других математических пакетах.


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

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


код кнопки:



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

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

Название: работа с деревьями Паскаль
Категория: лабы на Паскале
Формат файла: *.pas
Размер: 3.5 Kb
Просмотров: 8300
Загрузок: 2062
Комментариев: 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
0  
1 SkeLi   (10 Января 2010 в 22:03)
[Материал]
Некоторые функции неправильно написаны

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

Статистика

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


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

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

Яндекс цитирования Rambler's Top100

Сайт работает с 2008 года