Паскаль. Задача с деревьями

[vhett]

Будьте любезны помочь... Мне нужно дописать задачу, а не знаю как дальше. Условие такое: Из файла прочитать все символы, составить дерево на основе этих символов, удалить знаки препинания, вывести дерево. В файле англ алфавит и знаки препинания.

program exe;
uses crt;
type tree = ^elem;
elem = record
key:integer;
key2:char;
level:integer;
left, right:tree;
end;
var p: tree;



Function KolEl(var T:tree):integer;
begin
if T=nil then kolel:=0
else kolEL:=kolel(T^.Left)+1+kolel(T^.Right);
end;


procedure AddTree( var p:tree; D:integer);
begin
if p = nil then
begin
new(p);
p^.key:=D;
p^.left:= nil;
p^.right:= nil;
end
else
if kolEL(p^.left)<kolEL(p^.Right) then
AddTree(p^.left,D) else Addtree(p^.right,D);
end;


function ReadFile: String;
var
q:tree;
f: Text;
s: String;
i,n : integer;
symb:char;
begin
Assign(f, 'Z:\Alphabet.txt');
Reset(f);
Readln(f, s);
while not eof(f) do
begin
n:=length(s);
for i:= 1 to n do
begin
symb:=s[i];
{вставка symb в дерево, что выделено вероятно неверно }
new(p); 
p^.key2:=symb;
p^.left:=nil;
p^.right:=nil;
while symb=s[i] do
p^.key2:=symb;
p^.left:=p;
p^.right:=p;

end;
end;
Close(f);
end;


procedureAddSymbInTree(p: tree);
var
begin

end;


procedure PrintTree (p:Tree; h:integer);
var i:integer;
begin
if p=nil then exit;
with p^ do
begin
PrintTree(p^.right, h+1);
for i:=1 to h do
Write(' ');
write(' ',p^.key,' ');
writeLn;
PrintTree(p^.left, h+1);
end;
end;


Begin
kolEL(p);
AddTree(p, 0);
ReadFile;
PrintTree(p, 0);
END.

[vhett]

Не уже ли никто не знает?

[BDA]

Похоже за основу вы берете чужую программу?
У вас есть процедура AddTree. Ее подредактируйте, чтобы вставлять символы.

[denisbrain]

Сообщение от vhett

Не уже ли никто не знает?

может чем поможет

http://netsoftware.ucoz.ru/news/proc.../2012-02-29-15

и модуль работы со строками

http://programmersforum.ru/attachmen...8&d=1334685338

п.с. а пример файла можете предоставить

[vhett]

BDA. Прогу сам калякал... В том то и дело что не знаю как символ в дерево вставить, хотя бы код подскажите.

denisbrain. В файле такой текст: qwertyuiopasdfghjklzxcvbnm,.;:'"!

[BDA]

uses CRT;

type tree = ^elem;
  elem = record
    ch: char;
    left, right: tree;
  end;

var p: tree;


procedure AddTree(var p: tree; D: char);
begin
  if p = nil then
  begin
    new(p);
    p^.ch := D;
    p^.left := nil;
    p^.right := nil;
  end
  else
  begin
    if D > p^.ch then
      AddTree(p^.right, D)
    else
      Addtree(p^.left, D);
  end;
end;

procedure ClearTree(var p: tree);
begin
  if p = nil then exit;
  ClearTree(p^.right);
  ClearTree(p^.left);
  dispose(p);
  p := nil;
end;

procedure ReadFile(var p: tree);
var
  f: Text;
  c: char;
begin
  Assign(f, 'Alphabet.txt');
  Reset(f);
  while not eof(f) do
  begin
    read(f, c);
    addtree(p, c);
  end;
  Close(f);
end;

procedure PrintTree(p: Tree; h: integer);
var i: integer;
begin
  {if p = nil then exit;
  with p^ do
  begin
    PrintTree(p^.right, h + 1);
    for i := 1 to h do
      Write(' ');
    write(' ', p^.ch, ' ');
    writeLn;
    PrintTree(p^.left, h + 1);
  end; }
  if p = nil then exit;
  with p^ do
  begin
    writeln(p^.ch: h);
    PrintTree(p^.right, h + 2);
    PrintTree(p^.left, h + 2);
  end;
end;


begin
  ReadFile(p);
  PrintTree(p, 1);
  ClearTree(p);
  readln;
end.

Строит дерево. Печать в виде:

g
  x
  a

То есть в первом столбце корень, во втором его вершины, для каждой вершины точно так же.

[vhett]

Благодарю за помощь.

[BDA]

Пожалуйста)
Это еще не полная программа.
Она только строит дерево и выводит его.
Знаки препинания не удаляет.
Процедура ClearTree всего лишь освобождает память, занимаемую деревом (правила хорошего тона).

[vhett]

Что нужно записать вместо знака "?" в процедуре?

procedure DeleteZnak (p,y,prev:tree; c:string);
var x: string;   i: integer;
begin

if p = nil then writeln('elementa net')
  else if (c = ',') or (c='.') or (c=';') or(c= ':') or (c='!') or (c='?') then ?
  else if (c = ',') or (c='.') or (c=';') or(c= ':') or (c='!') or (c='?') then ?
  else begin
    p := t;
    if p^.r = nil then begin
      t := p^.l;
      dispose(p);
    end
    else if p^.Left = nil
      then begin
      t := p^.Right;
      dispose(p); end
    else d1(p^.Left)
  end;

[BDA]

uses CRT;

type tree = ^elem;
  elem = record
    ch: char;
    left, right, parent: tree;
  end;

var p: tree;
  delim: set of char;

procedure AddTree(var root: tree; D: char);
var
  p, q, tmp: tree;
begin
  p := root;
  new(tmp);
  tmp^.left := nil;
  tmp^.right := nil;
  tmp^.ch := D;
  q := nil;
  while (p <> nil) do
  begin
    q := p;
    if (D < p^.ch) then
      p := p^.left
    else
      p := p^.right;
  end;
  tmp^.parent := q;
  if q = nil then
    root := tmp
  else
    if D < q^.ch then
      q^.left := tmp
    else
      q^.right := tmp;
end;

function nextelem(root: tree): tree;
var
  p, q: tree;
begin
  p := root;
  if (p^.right <> nil) then
  begin
    p := p^.right;
    while (p^.left <> nil) do
      p := p^.left;
    nextelem := p;
  end
  else
  begin
    q := p^.parent;
    while (q <> nil) and (p = q^.right) do
    begin
      p := q;
      q := q^.parent;
    end;
    nextelem := q;
  end;
end;

procedure deleteelem(var root: tree; node: tree);
var
  x, y: tree;
begin
  if (node^.left <> nil) and (node^.right <> nil) then
    y := nextelem(node)
  else
    y := node;
  if y^.left <> nil then
    x := y^.left
  else
    x := y^.right;
  if (x <> nil) then
    x^.parent := y^.parent;
  if y^.parent = nil then
    root := x
  else
  begin
    if y = y^.parent^.left
      then
      y^.parent^.left := x
    else
      y^.parent^.right := x;
  end;
  if (y <> node) then
    node^.ch := y^.ch;
  dispose(y);
end;

procedure ClearTree(var p: tree);
begin
  if p = nil then exit;
  ClearTree(p^.right);
  ClearTree(p^.left);
  dispose(p);
  p := nil;
end;

procedure ReadFile(var p: tree);
var
  f: Text;
  c: char;
begin
  Assign(f, 'Alphabet.txt');
  Reset(f);
  while not eof(f) do
  begin
    read(f, c);
    addtree(p, c);
  end;
  Close(f);
end;

procedure PrintTree(p: Tree; h: integer);
begin
  if p = nil then exit;
  with p^ do
  begin
    writeln(ch: h);
    PrintTree(right, h + 2);
    PrintTree(left, h + 2);
  end;
end;

procedure DeleteDelimeters(var root: tree; var node: tree);
begin
  if node=nil then exit;
  DeleteDelimeters(root, node^.right);
  DeleteDelimeters(root, node^.left);
  if node^.ch in delim then
    deleteelem(root, node);
end;

begin
  delim := [',', '.', ';', ':', '!', '?'];
  p := nil;
  ReadFile(p);
  writeln('Source tree');
  PrintTree(p, 1);
  DeleteDelimeters(p, p);
  writeln;
  writeln('Clear tree');
  PrintTree(p, 1);
  ClearTree(p);
  readln;
end.

Переписал кое-что.
Опирался (точнее в наглую списывал) на лекции во вложении.