Бинарные деревья поиска, Определить пути в дереве, имеющие только Опции

[FENIX]

Задание:
Дан текстовый файл. Построить дерево поиска из символов этого файла. Определить пути в дереве, имеющие только согласные буквы. Все эти вершины отметить цветом.

Моя задумка заключается в следующем: в процедуре Print сравнивать входящую информацию с инфой в массиве и, соответственно, менять цвет.
Но что-то ничего не сравнивается
Не могу понять, как сделать правильно.

Program Lab;
Uses Crt;

Const n = 19;

Alphabet : array [1..n] of String =
   ('b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'q', 'r',
   's', 't', 'v', 'w', 'x', 'z');

Type DataType = String;

Type BTreePtr = ^BTree;

BTree = object
        Data : DataType;
        Barrier : boolean;
        Left, Right : BTreePtr;
        LLen, RLen : word;
        Constructor Init;
        Destructor Done;
        Procedure Print(K : word);
        Procedure Add_Search(D : DataType); virtual;
        {Procedure Main;}
end;

Constructor BTree.Init;
begin
   Barrier := TRuE;
end;

Destructor BTree.Done;
begin
   If not Barrier then
   begin
      Dispose(Left, Done);
      Dispose(Right, Done);
   end;
end;

Procedure BTree.Add_Search(D : DataType);
begin
   If Barrier then
   begin
      Data := D;
      Barrier := false;
      New(Left, Init);
      New(Right, Init);
   end
   else
   If D < Data then
   Left^.Add_Search(D) else Right^.Add_Search(D);
end;

============================== 

Procedure BTree.Print(K : word); 
var i : word;
begin
   If not Barrier then
   begin
      Left^.Print(k + 4);
      For i := 1 to n do
      If Data = Alphabet[i] then
      begin
         TextColor(Yellow);
      end
      else
      TextColor(7);
      writeln(Data : k);
      Right^.Print(k + 4);
   end;
end;

============================== 

var B1 : BTree;
   input : text;
   s, sl : string;
   i : word;

BEGIN
   ClrScr;
   assign(input, 'Lab_12.txt');
   reset(input);
   writeln('BEFORE - ', MemAvail, ' bytes.');
   writeln;
   B1.Init;

   While not EOF (input) do
   begin
      sl := '';
      Readln(input, s);
      If s[length(s)] <> ' '
      then s := s + ' ';
         For i := 1 to length(s) do
            If s[i] <> ' '
            then sl := sl + s[i]
            else
            If length(sl) <> 0 then
            begin
               B1.Add_Search(sl);
               sl := '';
            end;
   end;

   B1.Print(4);
   {B1.Main;}
   writeln;
   B1.Done;
   writeln('AFTER - ', MemAvail, ' bytes.');
   readln;

END.

Сообщение отредактировано: FENIX - 26.04.2005 17:24

[volvo]

FENIX, смотри, что меня настораживает... Тебе нужно

Определить пути в дереве, имеющие только согласные буквы

, а что ты делаешь?

For i := 1 to n do
  If Data = Alphabet[i] then ... 

это у тебя сравнивает строку с символом... Формально это допустимо (символ - это частный случай строки), но это будет всегда возвращать False, и как следствие - никакой подсветки разными цветами... Я бы ввел вместо того,что у тебя:

Alphabet : array [1..n] of String = ...

вот это:

const
  alpha = ['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'q', 'r',
           's', 't', 'v', 'w', 'x', 'z'];

и переписал бы BTree.Print вот так:

Procedure BTree.Print(K : word);
var
  i : word;
  only_cons: boolean;
begin
  If not Barrier then begin
    Left^.Print(k + 4);

    only_cons := true;
    For i := 1 to length(data) do
      only_cons := only_cons and (data[i] in alpha);
      { ищем строки, в которых присутствуют только согласные (consonants) }
      if only_cons then TextColor(Yellow) else TextColor(7);
    writeln(Data : k);
    textcolor(7);

    Right^.Print(k + 4);
  end;end;

Попробуй, должно сработать ... ;)

[FENIX]

volvo
Блин, какой-то завал...
Я и так, и сяк переделывал твою процедуру - не работает...
У меня создалось впечатление, что программа никак не реагирует на изменения...

З.Ы. Я из файла правильно информацию читаю? Вроде да, но заметил, что когда дерево выводится на экран, у "а" рядом стоит точка. Откуда?

[volvo]

Я и так, и сяк переделывал твою процедуру - не работает... У меня создалось впечатление, что программа никак не реагирует на изменения... 

А вот с этого места - поподробнее... Я этот кусок вытащил из отработавшей программы. Так вот, чтобы избежать в будущем такой ситуации, что у меня работает, а у тебя - нет, давай сразу пример тестового файла.

Это первое ... А второе: ты говоришь, что у тебя задание

Построить дерево поиска из символов этого файла

, почему же ты хранишь СТРОКИ, а не символы? Тебе же нужно посимвольно читать файл и КАЖДЫй символ заносить в дерево поиска, ты же заносишь целые слова... Определись, что нужно...

[FENIX]

Хммм...
Очень странно, но у меня твоя процедура наотрез отказывалась работать
...

Однако я ее переделал вот так :low: и все заработало:

If not Barrier then 
   begin
      Left^.Print(k + 4);
      only_cons := false;
      For i := 1 to length(Data) do
      begin
         If Data[i] in alpha then
         only_cons:=true;
      end;
      If only_cons then TextColor(Yellow) else TextColor(7);
      writeln(Data : k);
      textcolor(7);
      Right^.Print(k + 4);
   end;

З.Ы. Пример входного файла Lab_12.txt :

a o g l f k e h v y o i r s

З.З.Ы. Еще вопросик: если в файле будут большие буквы, то прога не учтет их. Как исправить, не добавляя константы из больших букв? Я что-то слышал-видел, связанное с UpCase...

Сообщение отредактировано: FENIX - 26.04.2005 22:03

[volvo]

если в файле будут большие буквы, то прога не учтет их. Как исправить, не добавляя константы из больших букв? Я что-то слышал-видел, связанное с UpCase...

Нет... Как раз наоборот, тебе нужно будет внести ТОЛЬКО большие буквы (не добавляя маленьких) и использовать UpCase:

For i := 1 to length(Data) do begin
  If UpCase(Data[i]) in alpha then only_cons:=true;
end;

Но стандартную функцию Паскаля можно использовать только если буквы у тебя латинские. Если же используется кириллица - поищи по форуму, выкладывалась функция для обработки любых символов (можешь посмотреть в моем модуле в FAQ: Строки, там точно есть...)

[FENIX]

Сегодня уточнил задание - необходимо также напечатать (в виде строки из букв после вывода дерева) сами пути. Как?

[volvo]

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

[volvo]

Например вот так (к сожалению, пришлось переделать твое дерево)

uses crt;
const
  alpha = ['B', 'C', 'D', 'F', 'G', 'H', 'K', 'L',
           'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'V',
           'W', 'X', 'Z'];

type
  TType = char;

  PTNode = ^TNode;
  TNode = object
    Data: TType;
    right, left: PTNode;
    constructor init(T: TType);
    destructor done;
  end;

  TTree = object
    root: PTNode;

    constructor init;
    destructor done;

    procedure add(Var p: PTNode;
              T: TType);
    procedure print;

  private
    arr: array[1 .. 255] of TType;
    count: integer;
    function find_check(T: TType): string;
  end;

constructor TNode.Init(T: TType);
begin
  Data := T;
  left := nil; right := nil;
end;
destructor TNode.Done;
begin end;

constructor TTree.init;
begin
  root := nil;
  count := 0;
end;

destructor TTree.done;

  Procedure Delete(T: PTNode);
  Begin
    If T = nil Then Exit;

    Delete(T^.Right);
    Delete(T^.Left);
    Dispose(T, Done)
  End;

begin
  Delete(root)
end;

procedure TTree.add(var p: PTNode;
          T: TType);

begin
  if p <> nil then
    with p^ do begin
      if Data < T then add(right, T)
      else
        if Data > T then add(left, T)
    end
  else new(p, Init(T))
end;


procedure TTree.print;

  procedure Indent(len: integer);
  var i: integer;
  begin
    for i := 1 to len do
      write(#32)
  end;

  procedure print_node(T: PTNode; level: integer);
  begin
    { store the leafs }
    if (T^.right = nil) and (T^.left = nil) then begin
      inc(count); arr[count] := T^.data;
    end;

    if T^.right <> nil then
      print_node(T^.right, level + 1)
    else begin
      indent(4 * (level + 1)); writeln('NIL');
    end;

    if upcase(T^.Data) in alpha then textcolor(yellow);
    indent(4 * level); writeln(T^.Data);
    textcolor(lightgray);



    if T^.left <> nil then
      print_node(T^.left, level + 1)
    else begin
      indent(4 * (level + 1)); writeln('NIL');
    end
  end;

begin
  print_node(root, 1)
end;

function TTree.find_check(T: TType): string;

var
  pp: PTNode;
  s: string;
  only_cons: boolean;
  i: integer;
begin
  s := '';
  if root <> nil then begin

    pp := root; s := root^.data;
    while pp <> nil do
      if T = pp^.data then break
      else begin
        if T < pp^.Data then pp := pp^.Left
        else pp := pp^.Right;

        s := s + pp^.data;
      end;
  end;

  only_cons := true;
  for i := 1 to length(s) do
    only_cons := only_cons and (upcase(s[i]) in Alpha);

  if only_cons then find_check := s
  else find_check := ''
end;


var
  f: text;
  tree: TTree;
  ch: char;
  i: integer;
  s: string;
begin
  assign(f, 'lab_12.txt');
  reset(f);
  tree.init;

  while not seekeof(f) do begin
    read(f, ch);
    tree.add(tree.root, ch);
  end;

  tree.print;

  for i := 1 to tree.count do begin
    s := tree.find_check(tree.arr[i]);
    if s <> '' then writeln(s);
  end;

  tree.done;
  close(f);
end.

[FENIX]

function TTree.find_check(T: TType): string;

var
  pp: PTNode;
  s: string;
  only_cons: boolean;
  i: integer;
begin
  s := '';
  if root <> nil then begin

    pp := root; s := root^.data;
    while pp <> nil do
      if T = pp^.data then break
      else begin
        if T < pp^.Data then pp := pp^.Left
        else pp := pp^.Right;

        s := s + pp^.data;
      end;
  end;

for i := 1 to tree.count do begin
    s := tree.find_check(tree.arr[i]);
    if s <> '' then writeln(s);
  end;

Вот же функция для распечатки путей, так? А нижний кусок кода - распечатка... Тогда почему у меня не печатает?
Может ли это как-нибудь быть связано с настройками самого Паскаля?

З.Ы. Я немного не понял, для чего печатать "NIL" на месте отсутствующих элементов...

Сообщение отредактировано: FENIX - 30.04.2005 12:19

[volvo]

Вот же функция для распечатки путей, так? А нижний кусок кода - распечатка...

:yes:

Тогда почему у меня не печатает?

А ты визуально проверил, есть ли пути в которых присутствуют ТОЛЬКО согласные буквы? Попробуй, например вот такой файл: "g l f k e h v r s a m t"... В нем точно есть пути только с согласными...

З.Ы. Я немного не понял, для чего печатать "NIL" на месте отсутствующих элементов... 

Я бы не называл это "отсутствующими" элементами. Просто ветка закончена... А NIL - для удобства (я так всегда делаю).

[FENIX]

Так...
Завел твой файл - тот же результат.
Пути весь печататься должны внизу под деревом в строчку, так?
У меня - пусто
"Нич-ч-е не понимаю" (С)

[volvo]

Ну, я не знаю, ЧЕМ и КАК ты компилируешь в конце концов. У меня BP, TMT, FPC, Dev-PAS и Турбо дают одинаковый результат... Хочешь - скину EXE - файл... Больше помочь ничем не могу, и программ больше я писать готовых тоже не буду... Уж ОЧЕНЬ часто то, что отрабатывает у меня НЕ работает у других. Sorry...

Кстати, F7 (пошаговый проход) никто не отменял. Пройди по программе шаг за шагом и посмотри, где она У ТЕБЯ не срабатывает...

Вот скриншот: