Question

Задан текстовый файл с произвольным именем. А, сколько слов содержит этот файл. Все слова разделены пробелами, не обязательно одиночными. Найдите все слова максимальной длины. Решать в PascalABC.NET, полное решение, пожалуйста. Желательно попроще, без лишних функций.

Answer 1

PascalABC.NET 3.4.2, сборка 1884 от 24.11.2018

Внимание! Если программа не работает, обновите версию!

begin

 var fn := ReadlnString('Введите имя файла:');

 if not FileExists(fn) then

 begin

   Print('Файл не найден');

   exit

 end;

 var a := ReadAllText(fn).ToWords; // массив слов

 Println('Количество слов в файле:', a.Length);

 var lmax := a.Select(w -> w.Length).Max;

 Println('Перечень слов с максимальной длиной');

 a.Where(w -> w.Length = lmax).Println

end.

Во втором вложении дается тестовый файл Pushkin2.txt

Answer 2

Для решения этой задачи в PascalABC.NET можно воспользоваться следующим кодом. Код прочитает текстовый файл, посчитает общее количество слов и найдет все слова максимальной длины:

pascalCopy code
Program WordCountAndMaxLength;

const
  MAX_FILE_NAME_LENGTH = 255;

Var
  FileName: String;
  FileText: String;
  WordsCount, MaxWordLength, WordLength, i, j: Integer;
  MaxWords: array of String;
  CurrentWord: String;

begin
  WriteLn('Введите имя файла: ');
  ReadLn(FileName);

  if not FileExists(FileName) then
  begin
    WriteLn('Файл не найден.');
    Exit;
  end;

  AssignFile(Input, FileName);
  Reset(Input);

  // Считываем текст из файла
  FileText := '';
  while not EOF do
  begin
    ReadLn(CurrentWord);
    FileText := FileText + ' ' + CurrentWord;
  end;

  CloseFile(Input);

  // Считаем количество слов в тексте
  WordsCount := 0;
  for i := 1 to Length(FileText) do
  begin
    if FileText[i] = ' ' then
      Inc(WordsCount);
  end;
  Inc(WordsCount); // добавляем последнее слово, так как в конце строки нет пробела

  // Находим все слова максимальной длины
  SetLength(MaxWords, 0);
  MaxWordLength := 0;
  CurrentWord := '';
  j := 0;

  for i := 1 to Length(FileText) do
  begin
    if FileText[i] <> ' ' then
      CurrentWord := CurrentWord + FileText[i]
    else
    begin
      WordLength := Length(CurrentWord);
      if WordLength > MaxWordLength then
      begin
        MaxWordLength := WordLength;
        SetLength(MaxWords, 1);
        MaxWords[0] := CurrentWord;
        j := 1;
      end
      else if WordLength = MaxWordLength then
      begin
        Inc(j);
        SetLength(MaxWords, j);
        MaxWords[j - 1] := CurrentWord;
      end;
      CurrentWord := '';
    end;
  end;
  
  // Последнее слово после цикла
  WordLength := Length(CurrentWord);
  if WordLength > MaxWordLength then
  begin
    SetLength(MaxWords, 1);
    MaxWords[0] := CurrentWord;
  end
  else if WordLength = MaxWordLength then
  begin
    Inc(j);
    SetLength(MaxWords, j);
    MaxWords[j - 1] := CurrentWord;
  end;

  WriteLn('Количество слов в файле: ', WordsCount);
  WriteLn('Слова максимальной длины (', MaxWordLength, ' символов):');
  for i := 0 to Length(MaxWords) - 1 do
    WriteLn(MaxWords[i]);

  ReadLn;
end.

Примечание:

1. В коде используется функция FileExists для проверки существования файла. Поэтому не забудьте подключить модуль SysUtils.
2. Предполагается, что слова разделяются только пробелами. Если в тексте используются другие разделители, код нужно будет немного изменить.
3. Этот код не является оптимальным с точки зрения производительности и структуры. Он скорее простой и понятный, что может быть полезным для обучения и начинающих программистов.