Обработка 1мб текста

[Kingdom_Reborn]

А это 15 вариант, вы в РГУ на 1 курсе учитесь? Кто преподаёт?

А по поводу решения - всё решается достаточно просто, позже приведу пример... Я на 1 курсе это на Borland Pascal писал...

[Macmeprag]

Григорьев преподает..=)
To Cnt
Нельзя потому что тогда 2001 первое подходящее слово будет сравниваться только с первым эл-том массива)
Вот в LettersOrder дельный совет, спасибо, что-то я там загнул)
На самом деле уже сдал, помогло добавление var во все процедуры и ф-ии где используется words -1 сек сразу у меня стало и -2.5 у него.
Спасибо всем)

[Kingdom_Reborn]

Macmeprag, повезло, Григорьев хорошо преподаёт...

[Macmeprag]

А у вас Дёмин чтоли был?
Ну да, повезло, но он требователен ко всему весьма и весьма..=)

[Kingdom_Reborn]

Сообщение от Macmeprag

А у вас Дёмин чтоли был?
Ну да, повезло, но он требователен ко всему весьма и весьма..=)

У нас другой преподаватель был, он сейчас там уже не работает, но нам тоже повезло, он ещё требовательней Григорьева был.

вот решение вашей задачи, засёк время - 11 мин. ушло на написание.

program lab21_v15;

{$APPTYPE CONSOLE}
{$R+}

uses
  SysUtils;

const
  Source = 'input.txt';
  Target = 'output.txt';
  Nmax = 2000;
  Alphabet = ['а'..'я', 'А'..'Я', 'ё', 'Ё'];

type TArray = Array[1..Nmax] of String;

function Check(Word: String): Boolean;
var
  i: Integer;
begin
  Word := AnsiUppercase(Word);
  Check := False;
  if Length(Word) < 3 then Exit;
  for i := 1 to Length(Word) - 2 do
    if (Word[i] <= Word[i + 1]) and (Word[i + 1] <= Word[i + 2]) then begin
      Check := True;
      Exit;
    end;
end;

procedure Sort(var A: TArray; const N: Integer);
var
  i, j: Integer;
  tmp: String;
begin
  for i := 1 to N - 1 do
    for j := i + 1 to N do
      if Length(A[i]) > Length(A[j]) then begin
        tmp := A[i];
        A[i] := A[j];
        A[j] := tmp;
      end;
end;

procedure Put(const Word: String; var A: TArray; var N: Integer);
var
  i, Len, Index: Integer;
  W: String;
begin
  W := AnsiUppercase(Word);
  if N < Nmax then begin
    for i := 1 to N do
      if W = AnsiUppercase(A[i]) then Exit;
    Inc(N);
    A[N] := Word;
    Exit;
  end;
  Len := Length(A[1]);
  Index := 1;
  for i := 1 to N do begin
    if W = AnsiUppercase(A[i]) then Exit;
    if Len > Length(A[i]) then begin
      Len := Length(A[i]);
      Index := i;
    end;
  end;
  if Length(Word) < Len then A[Index] := Word;
end;

var
  A: TArray;
  i, N: Integer;
  c: Char;
  Word: String;
begin
  Reset(Input, Source);
  Rewrite(Output, Target);
  while not EOF do begin
    Read(c);
    if c in Alphabet then begin
      Word := '';
      while not EOF and (c in Alphabet) do begin
        Word := Word + c;
        Read(c);
      end;
      if Check(Word) then Put(Word, A, N);
    end;
  end;
  Sort(A, N);
  for i := 1 to N do
    WriteLn(A[i]);
end.

[Macmeprag]

Этож что за зверь то такой..))
как должен выглядеть нулевой чекер для экзекутора, чтобы только время выполнения выдавал?
а то я что-то попробовал его написать, получил все по нулям

[Macmeprag]

Пустой аутпут на выходе..но выполнилась очень быстро на самом деле

[Kingdom_Reborn]

можно так написать

{$I+,O-,Q+,R+,S+}

var fres: TextFile;

begin
  Assign(fres, ParamStr(4));
  {$I-}
  rewrite(fres);
  {$I+}
  if IOResult <> 0 then Halt;

  write(fres, 0);

  close(fres);
end.

[Serge_Bliznykov]

Kingdom_Reborn
а скажите честно, Вы программу, которую выкладывал автор топика запускали? Файл output.txt получили? Содержимое этого файла видели?
А что Ваше творение создаёт?

Сообщение от Macmeprag

На самом деле уже сдал

Ну и здорово. Поздравляю!

[Kingdom_Reborn]

Сообщение от Serge_Bliznykov

Kingdom_Reborn
а скажите честно, Вы программу, которую выкладывал автор топика запускали? Файл output.txt получили? Содержимое этого файла видели?
А что Ваше творение создаёт?




Ну и здорово. Поздравляю!

Запускал (совю программу), всё там в output.txt нормально записано, а что? Слова с тремя одинаковыми подрядидущими буквами в порядке неубывания длины
.


/////////////////
а ну я условие как то не так прочитал... там буквы должны быть упорядочены
нужно в Check в проверке букв "=" заменить на "<=", делов то...