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

[volvo]

Хм... Вот так, наверное:

var s: string;
// ...

CurrLine := 0;
while seekeof(f) do
begin
  Inc(CurrLine);
  ReadLn(f, s);
  // тут - разбор строки s
end;

?

[Даша]

Да! Спасибо!

[Даша]

Вот то что получилось написать....

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;

Но не работает.. При вызове процедур WordInTree и Print ничего печатается.

[volvo]

При вызове процедур WordInTree и Print ничего печатается.

Неправда. Печатается. Не всё, но слова, выдранные из текста - печатаются. Номера строк - нет. Почему не всё? Потому, что заполняется дерево неправильно. Поправь, и будет выводиться то, что нужно.

[Даша]

Неправда. Печатается.

При запуске программы появляется пустая консоль и не более...

[volvo]

Да? Ну, смотри, что у меня появляется:

[Даша]

Ну а у меня чистое окно! Использую Borland Delphi Enterprise v7.0 (Build 4.453). Собственно, на нём же и буду сдавать задачу..

[volvo]

Значит, неправильно что-то описываешь. Поэтому всегда говорю: присоединяйте полный текст. Видишь, ты выложила часть, я дописал недостающее правильно, ты - нет. У меня отработало, у тебя - нет. Дельфи 2009/2010, кстати, тоже самое: список слов по алфавиту.

[Даша]

Выкладываю:

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

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.

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

[volvo]

Ай-яй-яй

program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Unit1 in 'Unit1.pas';
var 
    Root:TTree; x:T; // Вот эти 2 переменные - дублируются в модуле.
    f:text;
begin
 assign(f,'input.txt');
 reset(f);
 WordsInTree(f);
 Print(Root);
 readln; 
end.

Но если дублирование переменной X - ни к чему страшному не приведет, то дублирование Root фатально для твоей программы: при добавлении в дерево используется та переменная, которая описана в модуле, а потом, при печати - компилятор подсовывает в Print ту переменную Root, которая описана в основной части программы (а она не изменялась, и по прежнему равна nil). И дерево, хоть оно и было создано, просто не отображается. Понимаешь причину? Просто удали эти 2 описания из основной части, и увидишь разницу. Потом останется только правильно заполнять целочисленное дерево. Сейчас у тебя есть небольшая ошибка.

[Даша]

Да, понимаю. Каждый раз просто печатаю "ничего"

Добавлено через 17 мин.
Не могу сообразить с заполнением целочисленного дерева..

После строки:

a:=copy(s,back,i-back);

дописала:

IntInsert(X.Tree,n);

И в процедуре печати:

Procedure Print(var Root:TTree);
 Begin
  if Root<>nil then
   begin
    print(Root^.Left);
    begin
      write(Root^.Info.s,' ');
      writeln(Root^.Info.Tree^.info);
    end;
    print(Root^.Right)
   end
End;

Но безрезультатно..

[volvo]

После строки:

А зачем?

Смотри: ты нашла очередное слово (s). В переменной (n) хранится номер файловой строки. Что нужно сделать, чтобы добавить слово вместе с номером строки в дерево? Нужно добавить их вместе!!! Почему ты добавляешь по отдельности?

Я сделал так: в процедуре CreateNode, которая создает новый узел дерева (не целочисленного, а со строками), после инициализации сроки, инициализируешь и поддерево:

Procedure CreateNode(var p:TTree; n:T);
begin
   New(p);
   p^.Info.s:=n.s;
   p^.info.tree := nil;
   IntInsert(p^.info.tree, Unit1.n); // На самом деле лучше поменять название переменной

   p^.Left:=nil; p^.Right:=nil
End;

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

[Даша]

Ну думаю с этим я смогу справиться Огромное вам спасибо за помощь в решении данной задачи!

[Гость]

Помогите плиз с решение:
В данной строке найти самую длинную подстроку, состоя-щую из одинаковых символов. Надо в Turbo Pascal`е