Версия для печати темы

Автор: Mavra 23.04.2007 1:26

Задача: Перепишите в новый файл первую из строк, содержащих наибольшее число слов.

пробовала решить... но что-то не получается....

 program Project2;
uses
  SysUtils;

const E='F:\Documents and Settings\Àííà\Ðàáî÷èé ñòîë\file.txt';

type
TWords = array[1 .. 100] of string[100];
TDelimiter = set of Char;
var F,F1:Text;
i,count:Word;
words:TWords;
a,l,k,max:byte;
s:string;


function GetWords(s: string; var mas: TWords; delimiters: TDelimiter): Byte;
var i, p: Byte;
begin

for i := 1 to Length(s) do
if s[i] in delimiters then s[i] := #32;


repeat
p := Pos('  ', s);
if p > 0 then Delete(s, p, 1);
until p = 0;


if s[1] = ' ' then
Delete(s, 1, 1);


If s[Length(s)] = ' ' then
Delete(s, Length(s), 1);

i := 0;

repeat
p := Pos(' ', s); Inc(i);
if p > 0 then begin
mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p)
end
else mas[i] := s;
until p = 0;

GetWords := i;
end;

begin
Assign(F,E);
{$I-} Reset(F); {$I+}
If IOResult <> 0 Then
  Writeln('Fajl ne moget byt otkryt...')
Else
  Begin
  max:=1;

    k:=1;
    while not Eof(F) do
     begin
      readln(F,s[k]);
      count:=GetWords(s,words,[]);
      if count>max then
       begin
       max:=count;
       l:=k;
       end;
       Inc(k);
     end;
     a:=k;
     Rewrite(F1);
     for i:=1 to a do
      begin
      count:=GetWords(s[i],words,[]);
      if max=count then
      writeln(F1,s[i]);
      end;
    Close(F);
    Close(F1);
  End;
  readln;
end.

Автор: klem4 23.04.2007 1:34

Судя по всему слова в строке могут разделяться только пробелами (любое количество) ?

Автор: klem4 23.04.2007 2:19

В общем если да, то вот

var
  max_count: Integer = 0;
  result_string: String;

procedure DelSpace(var s: String);
var
  p: Byte;
begin
  p := pos('  ', s);
  if p <> 0 then repeat
    delete(s, p, 1);
    p := pos('  ', s);
  until p = 0;
end;

function Count(s: String): Byte;
var
  p: Byte;
begin
  if Length(s) = 0 then Count := 0 else begin
    p := Pos(' ', s);
    if p = 0 then Count := 1 else
     Count := 1 + Count(Copy(s, p + 1, 255));
  end;
end;

procedure GetMaxWordString(var f: Text);
var
  s: String;
  _count: Byte;
begin
  if not(eof(f)) then begin
    readln(f, s);
    DelSpace(s);
    _count := Count(s);
    if _count > max_count then max_count := _count;
    if not eof(f) then GetMaxWordString(f);
  end;

  if _count = max_count then result_string := s;
end;

var
  f, g: Text;

begin
  assign(f, 'text.txt'); reset(f);
  assign(g, 'new_text.txt'); rewrite(g);
  GetMaxWordString(f);
  writeln(g, result_string);
  close(f); close(g);
end.

Тестовый файл:


Прикрепленные файлы
 text.txt ( 137 байт ) Кол-во скачиваний: 208

Автор: Mavra 23.04.2007 11:12

klem4,спасибо!) Я только начинаю учиться, так что не все понимаю.... объясни пожайлуйста, что в этой строке делает ноль?

var
  max_count: Integer = 0;
 

и еще... как можно просмотреть результат потом?

Автор: Артемий 23.04.2007 11:29

Рискну ответить за него - обнуление счетчика.

Автор: klem4 23.04.2007 12:13

Открыть файл new_text.txt ?

Автор: Mavra 23.04.2007 13:04

ну... да

Добавлено через 7 мин.
все поняла) спасибо!)