Студопедия

Главная страница Случайная страница

Разделы сайта

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






  • Сервис онлайн-записи на собственном Telegram-боте
    Тот, кто работает в сфере услуг, знает — без ведения записи клиентов никуда. Мало того, что нужно видеть свое расписание, но и напоминать клиентам о визитах тоже. Нашли самый бюджетный и оптимальный вариант: сервис VisitTime.
    Для новых пользователей первый месяц бесплатно.
    Чат-бот для мастеров и специалистов, который упрощает ведение записей:
    Сам записывает клиентов и напоминает им о визите;
    Персонализирует скидки, чаевые, кэшбэк и предоплаты;
    Увеличивает доходимость и помогает больше зарабатывать;
    Начать пользоваться сервисом
  • Приложение А. type DataType = integer;






    (обязательное)

    Листинг программы

     

     

    uses Crt;

     

    type DataType = integer;

    type PTree=^TTree;

     

    TTree = record

    Data: DataType;

    Left, Right: PTree;

    end;

     

    label m1;

    var Tree: Ptree;

    ch: char;

    numb, i, nu: integer;

    Function NewElement(X: DataType): PTree; {размещение в куче нового элемента}

    Var T: PTree;

    Begin

    New (T);

    T^.Data: =X;

    T^.Right: =Nil;

    T^.Left: =Nil;

    NewElement: =T;

    End;

     

    Procedure AddElement(Var R: PTree; N: DataType); {размещение нового элемента в структуре}

    Begin

    If R< > Nil then begin

    If R^.Data< N then begin

    If R^.Left=nil then R^.Left: =NewElement(N) else AddElement(R^.Left, N);

    end

    else begin

    If R^.Right=nil then R^.Right: =NewElement(N) else AddElement(R^.Right, N);

    end;

    end

    else begin {дерево не создано, создаем его}

    R: =NewElement(N);

    end;

    End;

     

    Procedure Tab(n: Integer); {отступы, для вывода}

    var i: integer;

    Begin

    for i: =1 to n do write(' ');

    End;

     

    Procedure Print(T: PTree; g: integer); {Печать дерева. G-глубина }

    Const k=5;

    Begin

    If T=nil then Writeln ('Дерево пустое') else begin

    g: =g+1;

    If T^.Right < > nil then

    Print (T^.Left, g);

    Tab(k*g); Writeln (T^.Data);

    If T^.Left < > nil then

    Print (T^.Right, g);

    g: =g-1;

    End;

    End;

     

    Function Find(R: PTree; F: DataType): PTree; {Поиск элемента}

    Var t: Ptree;

    Begin t: =Nil;

    If R< > Nil then begin {Если дерево не пустое}

    If R^.Data=F then begin {Проверяем значение ключевого поля}

    t: =R; {Если нашли нужный элемент, запоминаем его значение}

    end

    else begin {если не нашли}

    t: =Find(R^.Left, F); {пытаемся найти в других ветвях дерева (сначала слева)}

    If t=Nil then t: =Find(R^.Right, F); {Потом справа, если слева ничего не нашли}

    end;

    end;

    Find: =t; {Результат функции - значение временной переменной t}

    End;

     

    function findwithparent(root: ptree; key: integer; var p, parent: ptree): Boolean; {находим вершину с род.}

    begin

    parent: =nil;

    p: =root;

    while p< > nil do begin

    if key=p^.data then begin { узел с таким ключом есть }

    findwithparent: =true;

    exit;

    end;

    parent: =p; {запомнить указатель на предка}

    if key> p^.data then

    p: = p ^. left {спуститься влево}

    else p: = p ^. right; {спуститься вправо}

    end;

    findwithparent: =false;

    end;

     

     

    procedure DeleteFromBinarySearchTree (Sought: DataType; {удаление элемента из дерева}

    var B: Ptree);

    var

    Delend, p, parent: Ptree;

     

    function DeleteLargest (var Site: Ptree): Datatype; {удаление самого бол. Элемента}

    var

    Delend: Ptree;

    begin

    if Site^.Right=nil then begin

    DeleteLargest: = Site^.Data;

    Delend: = Site;

    Site: = Site^.Left;

    Dispose (Delend)

    end

    else

    DeleteLargest: = DeleteLargest (Site^.Right)

    end;

    begin

    if B < > nil then begin

    if Sought > B^.Data then

    DeleteFromBinarySearchTree (Sought, B^.Left)

    else if B^.Data > Sought then

    DeleteFromBinarySearchTree (Sought, B^.Right)

    else

    begin { мы нашли элемент, который надо удалить }

    if (b^.left=nil) and (b^.right=nil) then {нет потомков}

    begin

    if (b^.data=tree^.data) then tree: =nil {если удаляемый элемент - корень}

    else

    begin

    findwithparent(tree, b^.data, p, parent);

    if parent^.left^.data=b^.data then parent^.left: =nil

    else parent^.right: =nil;

    dispose(p);

    end;

    end

    else if B^.Left=nil then begin {если только левое поддерево пустое}

    Delend: = B;

    B: = B^.Right;

    Dispose (Delend)

    end

    else if B^.Right=nil then begin {если только правое поддерево пустое}

    Delend: = B;

    B: = B^.Left;

    Dispose (Delend)

    end

    else

    B^.Data: = DeleteLargest (B^.Left) {если в обоих поддеревьях что-то есть}

    end

    end

    end;

     

    procedure InOrder(root: Ptree); {Cимметричный обход}

    begin

    if root< > nil then

    begin

    InOrder(root^.left);

    Write(root^.data, ' ');

    InOrder(root^.right);

    end;

    end;

     

    procedure PreOrder(root: Ptree); {Прямой обход}

    begin

    if root< > nil then

    begin

    write(root^.data, ' ');

    preorder(root^.left);

    preorder(root^.right);

    end;

    end;

     

    procedure PostOrder(root: PTree); {Обратный обход}

    begin

    if root< > nil then

    begin

    postorder(root^.left);

    postorder(root^.right);

    Write(root^.data, ' ');

    end;

    end;

     

    procedure DeleteTheTree(root: Ptree); {удалить всё дерево}

    begin

    if root< > nil then

    begin

    DeleteTheTree(root^.left);

    DeleteTheTree(root^.right);

    DeleteFromBinarySearchTree(root^.data, root);

    end;

    end;

     

    begin {главная программа}

    clrscr;

    m1: Tree: = nil;

    Writeln('Случайное заполнение узлов? Y/N ');

    ch: = ReadKey;

    ch: = UpCase(ch);

    if ch='Y' then {если заполнять случайно}

    begin

    randomize;

    writeln('Сколько узлов должно быть? ');

    readln(numb);

    for i: =1 to numb do

    begin

    nu: =random(100);

    AddElement(tree, nu);

    end;

    end

    else

    begin

    writeln('Введите свои числа. -1 - конец ввода');

    while true do

    begin

    readln(nu);

    if nu< > -1 then AddElement(tree, nu)

    else break;

    end;

    end;

     

    Print(tree, height(tree));

    writeln('');

    while (true) do

    begin

    writeln('');

    writeln('Что сделать? ');

    writeln('Поиск элемента - 1');

    writeln('Удаление элемента - 2');

    writeln('Прямой обход - 3');

    writeln('Симметричный обход - 4');

    writeln('Обратный обход - 5');

    writeln('Удалить дерево - 6');

    writeln('Создать новое - 7');

    writeln('Выход - q');

    readln(ch);

    ch: =upcase(ch);

    if (ch='1') then

    begin

    writeln('Введите число: ');

    readln(nu);

    if (Find(tree, nu)=nil) then writeln('Нет такого элемента')

    else writeln('Такой элемент есть');

    end

    else if (ch='3') then

    PreOrder(tree)

    else if (ch='4') then

    InOrder(tree)

    else if ch='5' then

    PostOrder(tree)

    else if ch='2' then

    begin

    writeln('Введите число: ');

    readln(nu);

    { deletenode(tree, nu); }

    DeleteFromBinarySearchTree(nu, tree);

    Print(tree, height(tree));

    end

    else if ch='6' then

    begin

    DeleteTheTree(tree);

    Print(tree, height(tree));

    end

    else if ch='7' then

    begin

    DeleteTheTree(tree);

    goto m1;

    end

    else exit;

    end;

    end.






    © 2023 :: MyLektsii.ru :: Мои Лекции
    Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав.
    Копирование текстов разрешено только с указанием индексируемой ссылки на источник.