Помощь - Поиск - Пользователи - Календарь
Полная версия: Файлы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Mavra
Задача: Перепишите в новый файл первую из строк, содержащих наибольшее число слов.

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


 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
Судя по всему слова в строке могут разделяться только пробелами (любое количество) ?
klem4
В общем если да, то вот smile.gif

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.


Тестовый файл:
Mavra
klem4,спасибо!) Я только начинаю учиться, так что не все понимаю.... объясни пожайлуйста, что в этой строке делает ноль?
var
  max_count: Integer = 0;
 


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

Артемий
Рискну ответить за него smile.gif - обнуление счетчика.
klem4
Цитата
и еще... как можно просмотреть результат потом?


blink.gif Открыть файл new_text.txt ?
Mavra
ну... да

Добавлено через 7 мин.
все поняла) спасибо!)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.