Написать программу, которая создает бинарное дерево

@west09999 · Регистрация: 08.12.2017

Author24 — интернет-сервис помощи студентам

Дан текстовый файл, содержащий текст размером не менее 10 строк. Написать программу, которая создает бинарное дерево, каждый элемент которого содержит слово из текста и количество его повторений. Напечатать все элементы дерева. Выбрать и напечатать элементы, которые являются листами дерева. Из слов, встречающихся более трех раз составить список, упорядоченный по количеству повторений и найти слово, встречающееся чаще остальных.

@JuriiMW · 12.12.2017, 09:33

Pascal

type
  tTree = ^rTree;
  rTree = record
    W : String;
    C : Integer;
    L, R : tTree;
  end;
  
type
  tList = ^rList;
  rList = record
    W : String;
    C : Integer;
    P, X : tList;
  end;
 
procedure PressEnter;
begin
  WriteLn('Нажмите Enter для продолжения...'); ReadLn;
end;
 
procedure PrintTree(Tree : tTree; path : String);
begin
  if Tree = nil then
    WriteLn('Дерево пусто!')
  else
    begin
      WriteLn(path, ': ', Tree^.W, ' (', Tree^.C, ')');
      if Tree^.L <> nil then PrintTree(Tree^.L, path + 'l');
      if Tree^.R <> nil then PrintTree(Tree^.R, path + 'r');
    end;
end;
 
procedure PrintFoliages(Tree : tTree; path : String);
begin
  if Tree = nil then
    WriteLn('Дерево пусто!')
  else
    begin
      if (Tree^.L = nil) and (Tree^.R = nil) then
        WriteLn(path, ': ', Tree^.W, ' (', Tree^.C, ')');
      if Tree^.L <> nil then PrintTree(Tree^.L, path + 'l');
      if Tree^.R <> nil then PrintTree(Tree^.R, path + 'r');
    end;
end;
 
function CreateTree(fName : String) : tTree;
 
  function NewTree(w : String) : tTree;
  var
    Tree : tTree;
  begin
    New(Tree);
    Tree^.W := w;
    Tree^.C := 1;
    Tree^.L := nil;
    Tree^.R := nil;
    
    NewTree := Tree;
  end;
  
  procedure AddTree(w : String; var Tree : tTree);
  begin
    if Tree = nil then
      Tree := NewTree(w)
    else
      if Tree^.W = w then
        Inc(Tree^.C)
      else if Tree^.W > w then
        if Tree^.L = nil then Tree^.L := NewTree(w) else AddTree(w, Tree^.L)
      else
        if Tree^.R = nil then Tree^.R := NewTree(w) else AddTree(w, Tree^.R);
  end;
  
  procedure StrToWords(s : String; var Tree : tTree);
  const
    NoWord = ' ,.!?:;-''"0123456789';
  var
    i : Integer;
    w : String;
  begin
    w := '';
    for i := 1 to Length(s) do
      if Pos(s[i], NoWord) > 0 then
        begin
          if Length(w) > 0 then
            AddTree(w, Tree);
          w := '';
        end
      else
        w := w + s[i];
    if Length(w) > 0 then
      AddTree(w, Tree);
  end;
 
var
  f : Text;
  s : String;
  Tree : tTree;
begin
  Tree := nil;
  
  Assign(f, fName);
  Reset(f);
  while Not EOF(f) do
    begin
      ReadLn(f, s);
      StrToWords(s, Tree);
    end;
  Close(f);
  
  CreateTree := Tree;
end;
 
function CreateList(Tree : tTree) : tList;
var
  List : tList;
  
  function NewList(Tree : tTree; p, x : tList) : tList;
  var
    List : tList;
  begin
    New(List);
    List^.W := Tree^.W;
    List^.C := Tree^.C;
    List^.P := p;
    List^.X := x;
    
    NewList := List;
  end;
  
  procedure AddList(Tree : tTree);
  var
    Cur : tList;
  begin
    if List = nil then
      List := NewList(Tree, nil, nil)
    else
      if List^.C > Tree^.C then
        begin
          List := NewList(Tree, nil, List); List^.X^.P := List;
        end
      else
        begin
          Cur := List;
          while (Cur^.X <> nil) and (Cur^.X^.C <= Tree^.C) do
            Cur := Cur^.X;
          if Cur^.X = nil then
            Cur^.X := NewList(Tree, Cur, nil)
          else
            begin
              Cur^.X := NewList(Tree, Cur, Cur^.X);
              if Cur^.X^.X <> nil then Cur^.X^.X^.P := Cur^.X;
            end;
        end;
  end;
  
  procedure Find(Tree : tTree);
  begin
    if Tree <> nil then
      begin
        if Tree^.C > 3 then
          AddList(Tree);
        if Tree^.L <> nil then Find(Tree^.L);
        if Tree^.R <> nil then Find(Tree^.R);
      end;
  end;
  
begin
  List := nil;
  
  Find(Tree);
  
  CreateList := List;
end;
 
procedure PrintList(List : tList);
var t : String[3];
begin
  t := '';
  if List = nil then
    Write('Список пуст!')
  else
    while List <> nil do
      begin
        Write(t, List^.W, ' (', List^.C, ')');
        List := List^.X;
        t := ' - ';
      end;
  WriteLn('.');
end;
 
function FindMax(List : tList) : Integer;
var
  Res : Integer;
begin
  Res := 0;
  while List <> nil do
    begin
      Res := List^.C;
      List := List^.X;
    end;
    
  FindMax := Res;
end;
 
function FindCount(List : tList; Count : Integer) : tList;
begin
  while (List <> nil) and (List^.C < Count) do
    List := List^.X;
  
  FindCount := List;
end;
 
var
  Root : tTree;
  List : tList;
  
begin
  Root := CreateTree('Info.info');
  WriteLn('Дерево создано.'); PressEnter;
  WriteLn('Все элементы дерева:'); PrintTree(Root, ''); PressEnter;
  WriteLn('Только листы дерева:'); PrintFoliages(Root, ''); PressEnter;
  List := CreateList(Root);
  WriteLn('Список создан.'); PressEnter;
  Write('Список: '); PrintList(List); PressEnter;
  Write('Встречается(ются) чаще остальных: '); PrintList(FindCount(List, FindMax(List)));
  WriteLn('Программа завершена.'); PressEnter;
end.

@west09999 · 12.12.2017, 13:38 **[ТС]**

Огромное спасибо!

@west09999 · 17.12.2017, 18:29 **[ТС]**

JuriiMW, Здравствуйте, простите за обращение, если вам не сложно можете еще раз помочь?

1. Все вхождения слова, встречающегося чаще остальных, в тексте заменить на его синоним (или антоним), вводимый с экрана. Для поиска использовать алгоритм Боуэра, Мура.

2. Определить количество произведенных замен.

@west09999 · 25.12.2017, 12:16 **[ТС]**

Программу сделал вот ответ!
Решение 2-го задания:

Pascal

type
s27 = string [40];
tfl = file of s27;
 
  tTree = ^rTree;
  rTree = record
    W : S27;
    C : Integer;
    L, R : tTree;
  end;
 
  tList = ^rList;
  rList = record
    W : S27;
    C : Integer;
    P, X : tList;
  end;
 
var
  Root : tTree;
  List : tList;
     f1: tfl;
     f : Text;
     s : S27;
  Tree : tTree;
 
const
simvol: array [1..27] of char = 'abcdefghijklmnopqrstuvwxyz ';
 
procedure PressEnter;
begin
  WriteLn('Press Enter to continue ...'); ReadLn;
end;
 
function filtr(str: s27): s27;
var L: integer; i, j: byte;
begin
L := length(str);
for i := 1 to L do
if str[i] <> ' ' then
for j := L downto 1 do
if str[j] <> ' ' then begin
filtr := copy(str, i, j - i + 1);
exit;
end;
filtr := '';
end;
 
procedure PrintTree(Tree : tTree; path : String);
begin
  if Tree = nil then
    WriteLn('Tree is empty!')
  else
    begin
      WriteLn(path, ': ', Tree^.W, ' (', Tree^.C, ')');
      if Tree^.L <> nil then PrintTree(Tree^.L, path + 'l');
      if Tree^.R <> nil then PrintTree(Tree^.R, path + 'r');
    end;
end;
 
procedure PrintFoliages(Tree : tTree; path : String);
begin
  if Tree = nil then
    WriteLn('Tree is empty!')
  else
    begin
      if (Tree^.L = nil) and (Tree^.R = nil) then
        WriteLn(path, ': ', Tree^.W, ' (', Tree^.C, ')');
      if Tree^.L <> nil then PrintFoliages(Tree^.L, path + 'l');
      if Tree^.R <> nil then PrintFoliages(Tree^.R, path + 'r');
    end;
end;
 
function CreateTree(fName : String) : tTree;
 
  function NewTree(w : String) : tTree;
  var
    Tree : tTree;
  begin
    New(Tree);
    Tree^.W := w;
    Tree^.C := 1;
    Tree^.L := nil;
    Tree^.R := nil;
 
    NewTree := Tree;
  end;
 
  procedure AddTree(w : String; var Tree : tTree);
  begin
    if Tree = nil then
      Tree := NewTree(w)
    else
      if Tree^.W = w then
        Inc(Tree^.C)
      else if Tree^.W > w then
        if Tree^.L = nil then Tree^.L := NewTree(w) else AddTree(w, Tree^.L)
      else
        if Tree^.R = nil then Tree^.R := NewTree(w) else AddTree(w, Tree^.R);
  end;
 
  procedure StrToWords(s : String; var Tree : tTree);
  const
    NoWord = ' ,.!?:;-''"0123456789';
  var
    i : Integer;
    w : String;
  begin
    w := '';
    for i := 1 to Length(s) do
      if Pos(s[i], NoWord) > 0 then
        begin
          if Length(w) > 0 then
            AddTree(w, Tree);
          w := '';
        end
      else
        w := w + s[i];
    if Length(w) > 0 then
      AddTree(w, Tree);
  end;
 
begin
  Tree := nil;
 
  Assign(f, 'kursovik.txt');
  Reset(f);
  while Not EOF(f) do
    begin
      ReadLn(f, s);
      StrToWords(s, Tree);
    end;
  Close(f);
 
  CreateTree := Tree;
end;
 
function CreateList(Tree : tTree) : tList;
var
  List : tList;
 
  function NewList(Tree : tTree; p, x : tList) : tList;
  var
    List : tList;
  begin
    New(List);
    List^.W := Tree^.W;
    List^.C := Tree^.C;
    List^.P := p;
    List^.X := x;
 
    NewList := List;
  end;
 
  procedure AddList(Tree : tTree);
  var
    Cur : tList;
  begin
    if List = nil then
      List := NewList(Tree, nil, nil)
    else
      if List^.C > Tree^.C then
        begin
          List := NewList(Tree, nil, List); List^.X^.P := List;
        end
      else
        begin
          Cur := List;
          while (Cur^.X <> nil) and (Cur^.X^.C <= Tree^.C) do
            Cur := Cur^.X;
          if Cur^.X = nil then
            Cur^.X := NewList(Tree, Cur, nil)
          else
            begin
              Cur^.X := NewList(Tree, Cur, Cur^.X);
              if Cur^.X^.X <> nil then Cur^.X^.X^.P := Cur^.X;
            end;
        end;
  end;
 
  procedure Find(Tree : tTree);
  begin
    if Tree <> nil then
      begin
        if Tree^.C > 3 then
          AddList(Tree);
        if Tree^.L <> nil then Find(Tree^.L);
        if Tree^.R <> nil then Find(Tree^.R);
      end;
  end;
 
begin
  List := nil;
 
  Find(Tree);
 
  CreateList := List;
end;
 
procedure PrintList(List : tList);
var t : String[3];
begin
  t := '';
  if List = nil then
    Write(' ')
  else
    while List <> nil do
      begin
        Write(t, List^.W, ' (', List^.C, ')');
        List := List^.X;
        t := ' - ';
      end;
  WriteLn('.');
end;
 
function FindMax(List : tList) : Integer;
var
  Res : Integer;
begin
  Res := 0;
  while List <> nil do
    begin
      Res := List^.C;
      List := List^.X;
    end;
 
  FindMax := Res;
end;
 
function FindCount(List : tList; Count : Integer) : tList;
begin
  while (List <> nil) and (List^.C < Count) do
    List := List^.X;
 
  FindCount := List;
end;
 
Procedure ReadFile(var f1: tfl);
var i: byte;
begin
seek(f1, 0);
repeat
read(f1, s);
writeln(s);
until eof(f1);
end;
 
procedure CreatFile;
 
procedure FillFile(str: s27);
begin
assign(f, str); reset(f);
while not seekeof(f) do begin
readln(f, s);
write(f1, s);
end;
close(f);
end;
 
begin
rewrite(f1);
FillFile('kursovik.txt');
ReadFile(f1);
close(f1);
end;
 
function Number(c:char):byte;
var i: byte;
begin
for i:= 1 to 27 do
if c=simvol[i] then Number:=i;
end;
 
Procedure Found(s,p,z :s27; n,m: byte; var c:byte);
var i,j,k,dl,h: byte;
d: array [1..27] of byte;
pr: array [1..20] of boolean;
poisk: boolean;
st1, st2: s27;
 
begin
for i:= 1 to 27 do d[i]:=m;
dl:=1;
for i:= m-1 downto 0 do begin
j:=Number(p[i]);
if d[j]=m  then d[j]:=dl;
inc(dl);
end;
 
i:=m; j:=m;
while (i>0) and (i<=n) do begin
for h:= 1 to m do pr[h]:=false;
j:=m; k:=i;
while (j>0) and (s[k]=p[j]) do begin
pr[j]:=true;
k:=k-1;
j:=j-1;
end;
 
if j=0 then begin
poisk:=true;
for i:= 1 to m do
if pr[i]=false then begin poisk:=false; break; end;
 
if poisk=true then begin {writeln(p, ' is found, k = ', k);}
 
st1:=''; st2:='';
if k>1 then
for i:= 1 to k do st1:=st1+s[i];
if (k+m)<n then
for i:= (k+m+1) to n do st2:=st2+s[i];
s:='';
s:=st1+z+st2;
inc(c);
end;
i:=m;
n:=length(s);
end else
i:=i+d[Number(s[i])];
end;
seek(f1, filepos(f1)-1); write(f1,s);
end;
 
procedure InText;
var cur: tList; s,p,z: s27; n,m,c: byte;
begin
Reset(f1);
cur:=FindCount(List, FindMax(List));
if cur=nil then Writeln('Error')
           else begin
c:=0;
While cur<>nil do begin
Writeln('Attention!!! Enter the world to replace the word ', cur^.W);
Readln(z);
z:=filtr(z);
p:=cur^.w;
p:=filtr(p); m:=length(p);
seek(f1,0);
repeat
read(f1,s);
s:=filtr(s); n:=length(s);
Found(s,p,z,n,m,c);
until eof(f1);
cur:=cur^.X;
end; end;
Writeln('Number of replacement: ', c);
end;
 
begin
  assign(f1, 'dan.exe');
  Root := CreateTree('Info.info');
  WriteLn('Tree created.'); PressEnter;
  WriteLn('All tree elements:'); PrintTree(Root, 'c'); PressEnter;
  WriteLn('Only the leaves of the tree:'); PrintFoliages(Root, ''); PressEnter;
  List := CreateList(Root);
  WriteLn('List created.'); PressEnter;
  Write('List: '); PrintList(List); PressEnter;
  Write('The word(s) meets more often than others: '); PrintList(FindCount(List, FindMax(List)));
  PressEnter;
  Writeln('Text: '); CreatFile; PressEnter;
  InText;  PressEnter;
  Writeln('Modified file: '); ReadFile(f1);
  WriteLn('The program is completed.'); PressEnter;
end.

Блоги программистов
Как перейти с Options API на Composition API в Vue.js BasicMan 06.01.2025 Почему переход на Composition API актуален В мире современной веб-разработки фреймворк Vue. js продолжает эволюционировать, предлагая разработчикам все более совершенные инструменты для создания. . .	Архитектура современных процессоров inter-admin 06.01.2025 Процессор (центральный процессор, ЦП) является основным вычислительным устройством компьютера, которое выполняет обработку данных и управляет работой всех остальных компонентов системы. Архитектура. . .	История создания реляционной модели баз данных, правила Кодда Programming 06.01.2025 Предпосылки создания реляционной модели В конце 1960-х годов компьютерная индустрия столкнулась с серьезными проблемами в области управления данными. Существовавшие на тот момент модели данных -. . .	Полезные поделки на Arduino, которые можно сделать самому raxper 06.01.2025 Arduino как платформа для творчества Arduino представляет собой удивительную платформу для технического творчества, которая открывает безграничные возможности для создания уникальных проектов. Эта. . .	Подборка решений задач на Python IT_Exp 06.01.2025 Целью данной подборки является предоставление возможности ознакомиться с различными задачами и их решениями на Python, что может быть полезно как для начинающих, так и для опытных программистов. . . .	С чего начать программировать микроконтроллеры raxper 06.01.2025 Введение в мир микроконтроллеров Микроконтроллеры стали неотъемлемой частью современного мира, окружая нас повсюду: от простых бытовых приборов до сложных промышленных систем. Эти маленькие. . .
Из чего собрать игровой компьютер inter-admin 06.01.2025 Сборка игрового компьютера требует особого внимания к выбору комплектующих и их совместимости. Правильно собранный игровой ПК не только обеспечивает комфортный геймплей в современных играх, но и. . .	Обновление сайта www.historian.by Reglage 05.01.2025 Обещал подвести итоги 2024 года для сайта. Однако начну с того, что изменилось за неделю. Добавил краткий урок по последовательности действий при анализе вредоносных файлов и значительно улучшил урок. . .	Как использовать GraphQL в C# с HotChocolate Programming 05.01.2025 GraphQL — это современный подход к разработке API, который позволяет клиентам запрашивать только те данные, которые им необходимы. Это делает взаимодействие с API более гибким и эффективным по. . .	Модель полного двоичного сумматора с помощью логических операций (python) AlexSky-coder 04.01.2025 def binSum(x:list, y:list): s=^y] p=x and y for i in range(1,len(x)): s. append((x^y)^p) p=(x and y)or(p and (x or y)) return s x=list() y=list()	Это мы не проходили, это нам не задавали...(асихронный счётчик с управляющим сигналом зад Hrethgir 04.01.2025 Асинхронный счётчик на сумматорах (шестиразрядный по числу диодов на плате, но наверное разрядов будет больше - восемь или шестнадцать, а диоды на старшие), так как триггеры прошли тестирование и. . .	Руководство по созданию бота для Телеграм на Python IT_Exp 04.01.2025 Боты для Телеграм представляют собой автоматизированные программы, которые выполняют различные задачи, взаимодействуя с пользователями через интерфейс мессенджера. В данной статье мы рассмотрим,. . .

@west09999 1 / 1 / 0 Регистрация: 08.12.2017 Сообщений: 12
		1
	Написать программу, которая создает бинарное дерево 11.12.2017, 13:23. Показов 2747. Ответов 4 Метки нет (Все метки) Дан текстовый файл, содержащий текст размером не менее 10 строк. Написать программу, которая создает бинарное дерево, каждый элемент которого содержит слово из текста и количество его повторений. Напечатать все элементы дерева. Выбрать и напечатать элементы, которые являются листами дерева. Из слов, встречающихся более трех раз составить список, упорядоченный по количеству повторений и найти слово, встречающееся чаще остальных. 0

@west09999 1 / 1 / 0 Регистрация: 08.12.2017 Сообщений: 12
	12.12.2017, 13:38 [ТС]	3
	Огромное спасибо! 0

@west09999 1 / 1 / 0 Регистрация: 08.12.2017 Сообщений: 12
	17.12.2017, 18:29 [ТС]	4
	JuriiMW, Здравствуйте, простите за обращение, если вам не сложно можете еще раз помочь? 1. Все вхождения слова, встречающегося чаще остальных, в тексте заменить на его синоним (или антоним), вводимый с экрана. Для поиска использовать алгоритм Боуэра, Мура. 2. Определить количество произведенных замен. 0

	25.12.2017, 12:16