Выписать слова в алфавитном порядке Опции

[Даша]

Добрый день! Помогите пожалуйста со следующей задачей:
Дан текстовый файл, состоящий из слов, разделенных пробелами и запятыми. Слова по строкам не переносятся.
Необходимо упорядочить слова в алфавитном порядке с указанием строк, в которых они встречаются. Реализовать
всё надо с помощью деревьев.

[Даша]

Выкладываю:

ОСНОВНОЙ ПРОЕКТ:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Unit1 in 'Unit1.pas';
var Root:TTree; x:T;
    f:text;

begin
 assign(f,'input.txt');
 reset(f);
 WordsInTree(f);
 Print(Root);
 readln; 
end.

МОДУЛЬ:


unit Unit1;

Interface
const
  StrLength = 15;
type
  TElem=integer;
  TIntTree=^TNodeInt;
  TNodeInt=record
    Info:TElem;
    Left,Right:TIntTree
  end;

  T=record
    s:string[StrLength];
    tree: TIntTree; { Это - тип "дерево целых" }
  end;

  TTree=^TNode;
  TNode=record
    info:T;
    Left, Right: TTree; { Потомки }
  end;

var n:integer;
    s:string;
    Root:TTree;
    x:T;
    IntRoot:TIntTree;

Procedure WordsInTree(var f:text);
Procedure Insert(var root:TTree; X:T);
Procedure IntInsert(var RootInt:TIntTree; x:TElem);
Procedure Print(var Root:TTree);

Implementation
Procedure IntInsert(var RootInt:TIntTree; x:TElem);
//Создание дерева целых чисел
Procedure CreateNode(var p:TIntTree; n:TElem);
//Дополнительная процедура, создающая и инициализирующая новый узел
  begin
	  New(p);
	  p^.Info:=n;
	  p^.Left:=nil;
	  p^.Right:=nil
  End;
Begin
	if RootInt=nil Then CreateNode(RootInt,X) { создаем новый узел дерева }
	else
		with RootInt^ do
     begin
			if info<X then IntInsert(Right,X)
			else
				if info>X Then IntInsert(Left,X)
		 end;
End;


Procedure Insert(var root:TTree; X:T);
//Создание дерева
Procedure CreateNode(var p:TTree; n:T);
  begin
	  New(p);
	  p^.Info:=n;
	  p^.Left:=nil;
	  p^.Right:=nil
  End;
begin
	if Root=nil Then CreateNode(Root, X)
	else
		with Root^ do
     begin
			if info.s<X.s then Insert(Right,X)
			else
				if info.s>X.s Then Insert(Left,X)
				else
         IntInsert(info.tree, n)
		 end;
end;

Procedure WordsInTree(var f:text);
var i,back:integer; a:string;
Begin
  n:=0;
  while not eof(f) do
    begin
     Inc(n);
     ReadLn(f,s);
     i:=1;
     while(i<=length(s)) do
      begin
        while(i<=length(s)) and (s[i] in [',',' ']) do
          inc(i);
        if i<=length(s) then
          begin
           back:=i;
           while(i<=length(s)) and not(s[i] in [',',' ']) do
            inc(i);
           a:=copy(s,back,i-back);
           IntInsert(IntRoot,n);
           X.s:=a;
           Insert(Root,X);
          end;
      end;
    end;
End;

Procedure Print(var Root:TTree);
var
 i:integer;
 Begin
  if Root<>nil then
   begin
    print(Root^.Left);
    writeln(Root^.Info.s);
    print(Root^.Right)
   end
End;


End.

Сообщение отредактировано: Даша - 14.12.2010 1:56