НИИ МЛЯ
(прокрастинация. профанация. прострация.)
На главную Отдел ИИ Отдел ПА Отдел РП Лаборатория ЕН Лаборатория ЭХ
Лаборатория разработки программ

PascalABC.Net - чья-то домашняя работа

(Принято к публикации 2015-11-22)

По мотивам вот этого вопроса.

Задание сформулировано так:

Разработать программу, формирующую случайным образом 3 таблицы слов длиной от 2 до 7 букв английского алфавита и записывающую сформированные данные в типизированный файл построчно. Программа должна прочитать эти строки из файла и вывести данные в виде таблиц: сначала таблицу 3, затем таблицу 1 и последней - таблицу 2. При выводе таблиц проанализировать текст и выделить цветом слова, удовлетворяющие заданному варианту, а также подсчитать их и вывести результат в отдельном окне. Смену таблиц организовать по нажатию клавиши "пробел".
Условие: Выделить цветом и подсчитать слова, в которых гласных не меньше, чем согласных.

Звучит, конечно, несколько глупо, Но всё же это не глупее нас, зачем-то выполнивших эту работу.

program Program1;

uses Crt;

const
  MinWordLen = 2;
  MaxWordLen = 7;
  WordCount  = 10;
  TableCount = 3;
  Vowel :set of Char = ['a', 'e', 'i', 'o', 'u'];
  TablePriority :array[1..TableCount] of Integer = (3, 1, 2);

function GenerateString :string;
var
  i, j, N :Integer;
  w :string;
begin
result := '';
for i := 0 to WordCount do
  begin
  w := '';
  N := random(MinWordLen, MaxWordLen);
  for j := 1 to N do
    w := w + chr(ord('a') + random(26));
  if result <> '' then result := result + ' ';
    result := result + w;
  end;
end;

function CheckWord(w:string) :boolean;
var
  i, L, count :Integer;
begin
L := length(w);
count := 0;
for i := 1 to L do
  if w[i] in Vowel then inc(count);
result := count >= (length(w) shr 1);
end;

function PrintAndCountWord(w :string) :Integer;
begin
result := 0;
if (CheckWord(w)) then
  begin
  TextColor(10);
  result := 1;
  end
else
  TextColor(15);
WriteLn(w);
end;

function PrintAndCountTable(table :string) :Integer;
var
  i, L :Integer;
  w :string;
begin
result := 0;
L := length(table);
w := '';
i := 1;
while(i <= L) do
  begin
  if (table[i] = ' ') then
    begin
    if (w <> '') then result := result + PrintAndCountWord(w);
    w := '';
    end
  else
    w := w + table[i];
  inc(i);
  end;
if (w <> '') then result := result + PrintAndCountWord(w);
TextColor(15);
end;

function ShowMenuAndReadChoice :string;
begin
result := '';
ClrScr();
TextColor(15);
WriteLn('Some funny program.');
WriteLn();
WriteLn('1 - create tables');
WriteLn('2 - write tables to disk');
WriteLn('3 - read tables from disk');
WriteLn('4 - show tables');
WriteLn('any other key - exit');
WriteLn();
Write('Enter your choice and hit : ');
ReadLn(result);
end;

var
  i :Integer;
  m :string;
  m_processed :Boolean;
  table :array [1..TableCount] of string;
  tableScore :array [1..TableCount] of integer;
  totalScore :Integer;
  F_name :string;
  F :Text;

begin

for i := 1 to TableCount do table[i] := '';

while true do
  begin

  m := ShowMenuAndReadChoice();
  m_processed := false;

  if m = '1' then
    begin
    for i := 1 to TableCount do table[i] := GenerateString();
    WriteLn();
    WriteLn('tables created successfully');
    WriteLn();
    WriteLn('Hit  to contunue');
    ReadLn();
    m_processed := true;
    end;

  if m = '2' then
    begin
    if table[1] = '' then
      begin
      WriteLn();
      WriteLn('you have to create tables before using this option');
      WriteLn();
      WriteLn('Hit  to contunue');
      ReadLn();
      continue;
      end;
    F_name := GetCurrentDir() + '\20151122.txt';
    Assign(F, F_name);
    Rewrite(F);
    for i := 1 to TableCount do WriteLn(F, table[i]);
    CloseFile(F);
    WriteLn();
    WriteLn('file ', F_name, ' has been written to disk');
    WriteLn();
    WriteLn('Hit  to contunue');
    ReadLn();
    m_processed := true;
    end;

  if m = '3' then
    begin
    F_name := GetCurrentDir() + '\20151122.txt';
    if not(FileExists(F_name)) then
      begin
      WriteLn();
      WriteLn('file ', F_name, ' not found');
      WriteLn();
      WriteLn('Hit  to contunue');
      ReadLn();
      continue;
      end;
    Assign(F, F_name);
    Reset(F);
    for i := 1 to TableCount do ReadLn(F, table[i]);
    CloseFile(F);
    WriteLn();
    WriteLn('file ', F_name, ' has been read');
    WriteLn();
    WriteLn('Hit  to contunue');
    ReadLn();
    m_processed := true;
    end;

  if m = '4' then
    begin
    if table[1] = '' then
      begin
      WriteLn();
      WriteLn('you have to create tables before using this option');
      WriteLn();
      WriteLn('Hit  to contunue');
      ReadKey();
      continue;
      end;
    for i := 1 to TableCount do
      begin
      ClrScr;
      WriteLn('Table ', TablePriority[i], ':');
      WriteLn();
      tableScore[TablePriority[i]] := PrintAndCountTable(table[TablePriority[i]]);
      WriteLn();
      WriteLn('Hit  to contunue');
      ReadKey();
      end;
    ClrScr;
    WriteLn('Summary:');
    WriteLn();
    for i := 1 to TableCount do
      begin
      WriteLn('table ', i, ' score ', tableScore[i]);
      totalScore := totalScore + tableScore[i];
      end;
    WriteLn('---');
    WriteLn('total score: ', totalScore);
    WriteLn();
    WriteLn('Hit  to contunue');
    ReadLn();
    m_processed := true;
    end;

  if not(m_processed) then
    break;

   end;

end.