Рабочий стол > DL Руководство пользователя > ... > Вспомогательные средства установки задач по программированию > Библиотека для написания checker'ов на DL > Просмотр
Библиотека для написания checker'ов на DL Войти | Зарегистрироваться   Просмотр версии для печати текущей страницы.

Добавлено Гуленко Алексей, последний раз изменено Гуленко Алексей Feb 20, 2017  (просмотр изменений)
Метки: 
(нет)

Библиотека DLChecker

Библиотека DLChecker разработана с целью упростить написание checker'ов для системы тестирования DelTA. Она включает следующие возможности:

Библиотека спроектирована таким образом, чтобы воспользоваться преимуществами стиля Pascal (в частности, отсутствие потребности в прямой работе с памятью), при этом обходя ограничения, заложенные в реализацию.

Для работы с библиотекой DLChecker нужен компилятор Free Pascal версии 3.0

Использование библиотеки DLChecker

Перед началом выполнения программы библиотека подменяет ExitProc программы, считывает аргументы запуска checker'а и сохраняет время запуска в переменные. При желании их значения можно изменить, но в большинстве случаев это не требуется.

Для взаимодействия с файлами входных и проверочных данных теста, а также файлом вывода, реализуем простые обработчики, использующие поток ввода по умолчанию. Валидация вывода решения производится в процессе чтения.
Проверку правильности решения следует выполнять после завершения валидации; код проверки также (для удобства читабельности) следует вынести в отдельную процедуру.

простой пример использования DLChecker
Uses
  DLChecker;

CONST
  MaxRes = 1000*1000*1000;		// ограничение на ответ, взято из условия задачи

VAR
  Res, Ans	: LongWord;

  Procedure ReadChk ();
  Begin
    ReadLn(Ans);			// в проверочном файле - верный ответ
  End;

  Procedure ReadOut ();
  Begin
    Res := ReadInt(1, MaxRes);		// корректный ответ - целое в диапазоне (0; 10^9]
    AssertEOF();			// больше в выводе ничего не должно быть
  End;

  Procedure Check ();
  Begin
    CAssert(Res = Ans, WrongAnswer);	// правильный ответ должен совпадать с авторским
    Succeed();				// все проверки пройдены => тест пройден
  End;

BEGIN
  ReadAll(Nil, @ReadChk, @ReadOut);	// из InFile читать не требуется
  Check();
END.

Для упрощения разработки были добавлены дополнительные средства. Примеры их использования можно найти ниже.

Интерфейс библиотеки DLChecker

Базовые значения и подпрограммы checker'а

Библиотека представляет набор наиболее распространённых комментариев к результату тестирования:

комментарии и ошибки
CONST
  Success	= 'OK!';				// тест успешно пройден
  Full		= 'Full mark!';				// тест с частичной оценкой пройден полностью
  Partial	= 'Partial mark';			// тест пройден частично
  CheckerFail	= 'Checker stopped with an error!';	// checker завершил работу некорректно (расчёт баллов не выполнен)
  BadIO		= 'Invalid output!';			// неверный формат вывода решения (валидация не пройдена)
  NoFile	= 'File not found!';			// файл решения не найден
  OutOfRange	= 'Given value out of range!';		// значение за пределами ожидаемого диапазона
  WrongAnswer	= 'Wrong answer!';			// ответ решения неверен (проверка правильности не пройдена)
  Excessive	= 'Excessive output!';			// файл решения содержит лишние непустые строки
  NoSubtask	= 'Bad check file (no subtask id)';	// в файле проверочных данных нужно указать подзадачу
  BadSubtask	= 'Bad check file (bad subtask id)';	// подзадача указана некорректно

Данные инициализации доступны для дальнейшего чтения и модификации (в случае необходимости):

данные инициализации
VAR
  InFile, ChkFile, OutFile	: AnsiString;	// пути к файлам входных и проверочных данных, и к файлу вывода решения
  MaxPoints			: Word;		// число баллов за тест
  StartTime			: TDateTime;	// время запуска решения

Для работы с интерфейсом определены вспомогательные типы:

вспомогательные типы
TYPE
  TProcedure	= Procedure ();				// процедура-обработчик
  TRound	= (RoundUp, RoundDown, RoundMath);	// тип округления (вверх, вниз, математическое)

Оценка выставляется следующими процедурами:

процедуры выставления оценки
// тест не пройден
Procedure RageExit (ErrMsg : AnsiString = BadIO);   Inline;
Procedure RageExit (Fmt : AnsiString;  Args : Array of Const);   Inline;
// вызвать RageExit если (not Condition)
Procedure CAssert (Condition : Boolean;  Const ErrMsg : AnsiString = BadIO);
Procedure CAssert (Condition : Boolean;  Const Fmt : AnsiString;  Const Args : Array of Const);   Inline;
// тест пройден
Procedure Succeed (Comment : AnsiString = Success);   Inline;
Procedure Succeed (Fmt : AnsiString;  Args : Array of Const);   Inline;
// тест пройден с оценкой Points баллов
Procedure Succeed (Points : Word;  Comment : AnsiString = Success);   Inline;
Procedure Succeed (Points : Word;  Fmt : AnsiString;  Args : Array of Const);   Inline;
// выставление частичной оценки
Procedure ScoreTest (Penalty, Mistakes : Word;  IsPartial : Boolean = True);
Procedure PercentScoreTest (Res, Ans : Int64;     IsPartial : Boolean = True;  RoundType : TRound = RoundMath);
Procedure PercentScoreTest (Res, Ans : Extended;  IsPartial : Boolean = True;  RoundType : TRound = RoundMath);

Все, кроме CAssert, завершают выполнение программы и выставляют оценку; CAssert проверяет условие и завершает выполнение, если оно не выполняется.
Аргументы Fmt и Args используются для форматирования комментария, скажем, вот так:

Succeed('Goal achieved in %d turns, used %.1f%% vertices.', [k, 100*Res/N]);
// -> комментарий вида "Goal achieved in 24 turns, used 68.9% vertices."

ScoreTest вычитает из максимального балла Penalty за каждую ошибку, подсчитанную в Mistakes; PercentScoreTest вычисляет процент баллов по соотношению Res/Ans (результат решения / проверочное значение). В обоих случаях результат ограничен диапазоном [0; MaxPoints], и в обоих случаях при IsPartial = False для неполного решения возвращается 0.

Для чтения файлов и валидации используются следующие подпрограммы:

процедуры валидации
// чтение входного и проверочного файла, и вывода решения (чтобы не читать файл, передаём Nil)
Procedure ReadAll (ReadIn, ReadChk, ReadOut : TProcedure);   Inline;
// с этого места в файле не должно быть непробельных символов; вызываем в конце ReadOut
Procedure AssertEOF ();   Inline;
Procedure AssertEOF (Var F : Text);
// чтение строки вида '#subtask-id' (разрешённые значения можно ограничить, указав через пробел в параметре Ids)
Function GetSubtask (Var F : Text): AnsiString;   Inline;
Function GetSubtask (Var F : Text;  Const Ids : AnsiString): AnsiString;   Inline;
Function GetSubtask (Const Ids : AnsiString): AnsiString;   Inline;
Function GetSubtask (): AnsiString;   Inline;
// парсинг/чтение строки с целым числом из диапазона [MinValue; MaxValue] или [0; MaxValue]
Function ParseInt  (Const S : AnsiString;  MinValue, MaxValue : LongInt): LongInt;   Inline;
Function ParseUInt (Const S : AnsiString;  MaxValue : LongWord): LongWord;   Inline;
Function ReadInt  (MinValue, MaxValue : LongInt): LongInt;   Inline;
Function ReadUInt (MaxValue : LongWord): LongWord;   Inline;

Для проверки производительности можно получить текущее время работы checker'а:

тестирование производительности
Function SecondsRunning (): Double;   Inline;

Утилитарные типы и подпрограммы

Для упрощения разработки определены дополнительные типы и функции:

дополнительные типы
TYPE
  TCharSet	= Set of Char;						// множество ASCII-символов
  TWords	= Array of AnsiString;					// динамический массив строк
  TIndex	= {$IfDef CPU64} Int64 {$Else} Integer {$EndIf};	// целочисленный тип по умолчанию

TIndex предназначен для индексирования по нецелым значениям (перегружаем присваивание типа в TIndex, и его можно использовать как индекс массива или строки).

дополнительные функции
// генерация множества из строки
Function CharSet (Const S : AnsiString): TCharSet;
// разбиение переданной/прочтённой строки на подстроки по заданным разделителям
Function Split (Const S : AnsiString;  Const SplitChars : TCharSet = [' ']): TWords;
Function Split (Const S, SplitChars : AnsiString): TWords;   Inline;
Function ReadSplit (Const SplitChars : TCharSet = [' ']): TWords;   Inline;
Function ReadSplit (Const SplitChars : AnsiString): TWords;   Inline;
// ReadLn(S) как функция (не требует переменной для результата и вынесения в отдельную строку)
Function ReadString (): AnsiString;   Inline;
// подсчёт значений по условию (для циклов) и подсчёт размера подмножества, описанного TCharSet'ом или булевским массивом
Procedure Count (Var Counter : LongWord;  Condition : Boolean;  X : LongWord = 1);
Procedure Count (Var Counter : Word;      Condition : Boolean;  X : Word = 1);
Procedure Count (Var Counter : Byte;      Condition : Boolean;  X : Byte = 1);
Function CountSet (Const S : Array of Boolean): LongWord;
Function CountSet (Const S : TCharSet): Word;

Для сортировки, поиска и проверки на равенство используются функции-компараторы:

компараторы для базовых типов
CONST // значения результата по умолчанию
  LT	= -1;
  EQ	=  0;
  GT	= +1;

Function CompareInt (Const A, B : LongInt): Integer;
Function CompareUInt (Const A, B : LongWord): Integer;
Function CompareBool (Const A, B : Boolean): Integer;
// для строк используем CompareStr или CompareText в SysUtils (CompareText регистронечувствителен)

Векторы

Для упрощения работы с массивами был реализован тип-обёртка Вектор, с реализацией наиболее распространённых операций (для поддержки произвольных типов он был определён как шаблон). Также были сгенерированы типы векторов для базовых типов Pascal.

шаблон вектора
TYPE
  Generic GVector<_T> = Object
   Type
    _Data	= Array of _T;				// динамический массив элементов
    _Cmp	= Function (Const A, B : _T): Integer;	// компаратор элементов
    _Gen	= Function (): _T;			// генератор элементов (например, читающий из файла)
    _IGen	= Function (Index : LongWord): _T;	// генератор элементов по индексу (1..Length)
    _Upd	= Procedure (Var X : _T);		// модификатор элемента
    _Enum	= Object				// итератор - для поддержки оператора for-in
     Public
      Constructor Create (Const Vector : GVector);
      Function MoveNext (): Boolean;   Inline;
      Property Current: _T Read _Current;
    End;
   Public
    // "лёгкий" конструктор, использующий готовый массив (использовать при необходимости оптимизации)
    Constructor Wrap (Arr : _Data;  DefOrder : _Cmp = Nil);
    // конструктор, создающий вектор указанного размера - неинициализированный либо заполненный DefValue
    Constructor Create (Size : LongWord;  DefOrder : _Cmp = Nil);
    Constructor CreateFilled (Size : LongWord;  Const DefValue : _T;  DefOrder : _Cmp = Nil);
    // конструктор, инициализирующий позиции вектора с помощью генератора (или модификатора)
    Constructor Generate (Size : LongWord;  Gen : _Gen;  DefOrder : _Cmp = Nil);
    Constructor Generate (Size : LongWord;  Gen : _IGen;  DefOrder : _Cmp = Nil);
    Constructor Generate (Size : LongWord;  Upd : _Upd;  DefOrder : _Cmp = Nil);
    // конструктор копирования (с поддержкой сортировки по заданному компаратору и удалением дубликатов)
    Constructor Clone (Const From : Array of _T;  DefOrder : _Cmp = Nil);
    Constructor Clone (Const Other : GVector);
    Constructor CloneSorted (Const Other : GVector;  Order : _Cmp;  Unique : Boolean = False);
    // O(N) базовые операции
    Function Equals (Const Other : GVector): Boolean;	// проверка на равенство (использует DefOrder)
    Procedure Resize (Size : LongWord);   Inline;	// изменение длины вектора
    // O(N) заполнение новыми значениями (см. Generate)
    Procedure Fill (Const Value : _T);
    Procedure FillGen (Gen : _Gen);
    Procedure FillGen (Gen : _IGen);
    Procedure PMap (Upd : _Upd);
    // O(1) доступ по индексу (чтение, запись, модификация)
    Function Get (Index : LongWord): _T;   Inline;
    Procedure Put (Index : LongWord;  Const Value: _T);   Inline;
    Procedure Apply (Index : LongWord;  Upd : _Upd);   Inline;
    // O(1) доступ к свойствам "отсортировано" и "нет повторов" (устанавливаются в Sort, сбрасываются при записи)
    Function IsSorted (): Boolean;   Inline;
    Function AllUnique (): Boolean;   Inline;
    // O(N) конкатенация (в копию и мутацией)
    Function Concat (Const Other : GVector): GVector;   Inline;
    Procedure Append (Const Other : GVector);
    // O(NlogN) слияние множеств (вызывает Sort)
    Procedure AddAll (Const Other : GVector);
    Procedure AddAll (Const Other : GVector;  Unique : Boolean);
    // O(N) "разворот" вектора (сбрасывает сортировку)
    Procedure Reverse ();
    // поиск: O(logN) в отсортированном (IsSorted) векторе, иначе O(N) с сообщением в консоль
    Function Contains (Value : _T): Boolean;   Inline;
    Function Find (Value : _T): LongWord;
    // сортировка слиянием: O(1) при повторном вызове, O(N) для упорядоченного вектора, иначе O(NlogN)
    Procedure Sort (Unique : Boolean = False);   Inline;
    Procedure Sort (Order : _Cmp;  Unique : Boolean = False);
    // O(N) создание копии; для сортированных вызывается Sort
    Function Copy (): GVector;   Inline;
    Function Reversed (): GVector;   Inline;
    Function Sorted (Unique : Boolean = False): GVector;   Inline;
    Function Sorted (Order : _Cmp;  Unique : Boolean = False): GVector;   Inline;
    // итератор, доступ по индексу (V[i]) и вспомогательные свойства
    Function GetEnumerator (): _Enum;   Inline;
    Property Items[Index : LongWord]: _T Read Get Write Put;   Default;
    Property RawData: _Data Read Data;		// прямой доступ к массиву (ИЗБЕГАТЬ)
    Property Length: LongWord Read Len;
    Property Comparator: _Cmp Read Cmp;
  End;
  // типы векторов для базовых типов
  TInts		= Specialize GVector<LongInt>;
  TUInts	= Specialize GVector<LongWord>;
  TBools	= Specialize GVector<Boolean>;
  TStrings	= Specialize GVector<AnsiString>;

Для поддержки сравнения, сортировки и поиска требуется задать компаратор, поэтому для базовых типов были определены функции генерации векторов:

генераторы сортируемых векторов
// с помощью Create (Strings использует CompareStr, IStrings - CompareText)
Function Ints (Size : LongWord): TInts;   Inline;
Function UInts (Size : LongWord): TUInts;   Inline;
Function Bools (Size : LongWord): TBools;   Inline;
Function Strings (Size : LongWord): TStrings;   Inline;
Function IStrings (Size : LongWord): TStrings;   Inline;
// с помощью Generate
Function Ints (Size : LongWord;  Gen : TInts._Gen): TInts;   Inline;
Function UInts (Size : LongWord;  Gen : TUInts._Gen): TUInts;   Inline;
Function Bools (Size : LongWord;  Gen : TBools._Gen): TBools;   Inline;
Function Strings (Size : LongWord;  Gen : TStrings._Gen): TStrings;   Inline;
Function IStrings (Size : LongWord;  Gen : TStrings._Gen): TStrings;   Inline;
Function Ints (Size : LongWord;  Upd : TInts._Upd): TInts;   Inline;
Function UInts (Size : LongWord;  Upd : TUInts._Upd): TUInts;   Inline;
Function Bools (Size : LongWord;  Upd : TBools._Upd): TBools;   Inline;
Function Strings (Size : LongWord;  Upd : TStrings._Upd): TStrings;   Inline;
Function IStrings (Size : LongWord;  Upd : TStrings._Upd): TStrings;   Inline;
// с помощью Clone
Function Ints (Const From : Array of LongInt): TInts;   Inline;
Function UInts (Const From : Array of LongWord): TUInts;   Inline;
Function Bools (Const From : Array of Boolean): TBools;   Inline;
Function Strings (Const From : Array of AnsiString): TStrings;   Inline;
Function IStrings (Const From : Array of AnsiString): TStrings;   Inline;
// целочисленные диапазоны [1; Num] и [Fro; To_], с возможностью задания шага (удобно для for-in)
Function Range (Num : LongInt): TInts;   Inline;
Function Range (Num : LongWord): TUInts;   Inline;
Function Range (Fro, To_ : LongInt;  Step : LongInt = 1): TInts;
Function Range (Fro, To_ : LongWord;  Step : LongInt = 1): TUInts;

Множества

Вектор поддерживает операции для работы над множествами (поиск элемента, слияние множеств), но для использования вектора в таком качестве требуется пересортировка (O(NlogN)) при каждом изменении, что удобно отнюдь не во всяком случае. Поэтому на основе сортируемых векторов был реализован шаблон множеств. Эта реализация использует изначально заданное значение полного множества (вхождение определяется булевским вектором), но поддерживает добавление/удаление элемента за O(logN); групповые операции дают оценку O(NlogN) в худшем случае (эквивалентно поодиночной обработке значений). Множества одного типа, но с разными надмножествами совместимы; единственное техническое ограничение – элемент, не входящий в надмножество данного множества, добавлен не будет (при создании нового множества за основу берётся первое). При потребности расширения можно сделать новое множество на основе текущего (расширив копию надмножества).

шаблон множества
TYPE
  Generic GSet<_E> = Object
   Type
    _Elems	= Specialize GVector<_E>;	// вектор-надмножество
   Public
    // O(NlogN) конструктор, инициализирующий заданным значением или подмножеством
    Constructor Create (Const From : _Elems;  Full : Boolean = False);
    Constructor Create (Const From, Initial : _Elems);
    // O(N) конструктор копирования
    Constructor Clone (Const Other : GSet);
    // O(NlogN) статическая функция, конвертирующая вектор во множество
    Function Convert (Const From : _Elems): GSet;   Inline; Static;
    // O(N) проверка на равенство (включая надмножество) и очистка множества
    Function Equals (Const Other : GSet): Boolean;   Inline;
    Procedure Clear ();   Inline;
    // O(logN) доступ к значениям (поиск, добавление, удаление)
    Function Contains (Const Elem : _E): Boolean;   Inline;
    Procedure Put (Const Elem : _E);
    Procedure Del (Const Elem : _E);
    // O(1) доступ к свойствам "пустое" и "компаратор"
    Function IsEmpty (): Boolean;   Inline;
    Function Comparator (): _Elems._Cmp;   Inline;
    // O(N) получение надмножества и текущего множества как вектора
    Function GetFullSet (): _Elems;   Inline;
    Function GetItems (): _Elems;
    // O(NlogN) групповые модификации множества (поддерживают векторы)
    Procedure PutAll (Const Elems : _Elems);		// объединение
    Procedure DelAll (Const Elems : _Elems);		// разность
    Procedure KeepAll (Const Elems : _Elems);		// пересечение
    Function ContainsAll (Const Elems : _Elems): Boolean;
    // O(NlogN) операции над множествами (переписывают текущее)
    Procedure Merge (Const Other : GSet);   Inline;
    Procedure Intersect (Const Other : GSet);   Inline;
    Procedure Subtract (Const Other : GSet);   Inline;
    Procedure MergeExclusively (Const Other : GSet);   Inline;
    Function IsSubset (Const Other : GSet): Boolean;   Inline;
    // O(NlogN) операции над множествами (создают новое)
    Function Union (Const Other : GSet): GSet;   Inline;
    Function Intersection (Const Other : GSet): GSet;   Inline;
    Function Difference (Const Other : GSet): GSet;   Inline;
    Function SymmetricDifference (Const Other : GSet): GSet;   Inline;
    // всмопогательные свойства
    Property RawValues: TBools Read Values;		// прямой доступ к значениям (ИЗБЕГАТЬ)
    Property Size: LongWord Read Cardinality;		// размер множества
    Property Length: LongWord Read Len;			// размер надмножества
  End;
  // типы множеств для базовых типов
  TIntSet	= Specialize GSet<LongInt>;
  TUIntSet	= Specialize GSet<LongWord>;
  TStringSet	= Specialize GSet<AnsiString>;

Словари

Также на основе векторов был реализован шаблон словарей. Они (как и множества) используют логарифмический поиск по отсортированному вектору изначально заданных ключей. Если такой подход слишком медленный (и не выходит подобрать более подходящий алгоритм), можно использовать альтернативную реализацию множества или вектора на основе конвертирования типа в целочисленный, сбалансированных деревьев или хэш-таблиц по строковым ключам (последние два варианта требуют самостоятельной работы с памятью и указателями).

Также в словари была добавлена возможность завершить тестирование (с непройденным тестом) при попытке получения значения по несуществующему ключу (см. GetOrFail).

шаблон словаря
// ---- Dictionary type (with static key set and logN key access) ----
TYPE
  Generic GDict<_K, _V> = Object
   Type
    _I	= Record				// ячейка ключ-значение
      Key	: _K;
      Value	: _V;
    End;
    _Keys	= Specialize GVector<_K>;	// вектор ключей
    _Values	= Specialize GVector<_V>;	// вектор значений
    _Items	= Array of _I;			// ассоциативный массив
    _Upd	= Procedure (Var Value : _V);	// модификатор значения
   Public
    // конструктор, позволяющий инициализовать значением или вектором значений
    Constructor Create (Const KeyList : _Keys);
    Constructor Create (Const KeyList : _Keys;  Const Default : _V);
    Constructor Create (Const KeyList : _Keys;  Const Initial : _Values);
    // конструктор копирования
    Constructor Clone (Const From : Array of _I;  Order : _Keys._Cmp);
    Constructor Clone (Const Dict : GDict);
    Constructor Clone (Const Dict : GDict;  Const Default : _V);
    // O(N) базовые операции (сравнение, заполнение)
    Function Equals (Const Other : GDict;  VCmp : _Values._Cmp = Nil): Boolean;
    Procedure Reset (Const Value : _V);
    // O(logN) доступ к элементу (поиск, получение, запись, модификация)
    Function HasKey (Const Key : _K): Boolean;   Inline;
    Function Get (Const Key : _K): _V;   Inline;
    Function Get (Const Key : _K;  Const Default : _V): _V;
    Function GetOrFail (Const Key : _K;  Const ErrMsg : AnsiString = BadIO): _V;   Inline;
    Function GetOrFail (Const Key : _K;  Const ErrMsg : AnsiString;  Const Args : Array of Const): _V;   Inline;
    Procedure Put (Const Key : _K;  Const Value : _V);   Inline;
    Procedure Apply (Const Key : _K;  Upd : _Upd;  Fail : TProcedure = Nil);
    // O(N) получение вектора ключей, вектора значений и ассоциативного массива
    Function GetKeys (): _Keys;   Inline;
    Function GetValues (): _Values;   Inline;
    Function GetItems (): _Items;
    // доступ к свойству "компаратор" и вспомогательные свойства
    Function Comparator (): _Keys._Cmp;   Inline;
    Property Items[Key : _K]: _V Read Get Write Put;   Default;
    Property RawValues: _Values Read Values;		// прямой доступ к значениям (ИЗБЕГАТЬ)
    Property Length: LongWord Read Len;
  End;
  // типы словарей для базовых типов по строковым ключам
  TStringInts		= Specialize GDict<AnsiString, LongInt>;
  TStringUInts		= Specialize GDict<AnsiString, LongWord>;
  TStringBools		= Specialize GDict<AnsiString, Boolean>;
  TStringStrings	= Specialize GDict<AnsiString, AnsiString>;

Примеры применения

С использованием DLChecker были установлены несколько олимпиад, в частности, Московские олимпиады 2014-2016 годов.

Приведённые примеры:

реализация checker'а по умолчанию
{$Mode ObjFPC}
Uses
  DLChecker;

VAR
  Chk, Out      : TStrings;

  Function ReadLines(): TStrings;
  Var
    N   : LongWord;
  Begin
    Result := Strings(16);
    N := 0;
    While not EoF Do Begin		// динамическая инициализация вектора неизвестной длины
      Inc(N);
      If (N > Result.Length)
        Then Result.Resize(N+N);
      Result[N] := ReadString();
    End;
    While (N > 0) and (Result[N] = '')	// пустые строки в конце файла не считаем
      Do Dec(N);
    Result.Resize(N);
  End;

  Procedure ReadChk ();
  Begin
    Chk := ReadLines();
  End;

  Procedure ReadOut ();
  Begin
    Out := ReadLines();
  End;

  Procedure Check ();
  Begin
    CAssert(Chk.Equals(Out), WrongAnswer);
    Succeed();
  End;

BEGIN
  ReadAll(Nil, @ReadChk, @ReadOut);
  Check();
END.

Msk2015 G (использование TIndex)
{$Mode ObjFPC}
Uses
  DLChecker, Math;

TYPE
  TMap  = Array [0..MaxM] of Boolean;
  TCrd  = Record
    X, Y        : SmallInt;
  End;

  Function Crd (Const X, Y : SmallInt): TCrd;   Inline;
  Begin
    Result.X := X;
    Result.Y := Y;
  End;

  Operator + (Const A, B : TCrd): TCrd;   Inline;
  Begin
    Exit( Crd(A.X+B.X, A.Y+B.Y) );
  End;

// ...

VAR
  Sol   : Array of TMap;
  H, W  : Word;
  N     : Byte;

  Operator := (Const XY : TCrd): TIndex;	// автоматическое приведение типа
  Begin
    With XY
      Do If (0 < X) and (X <= W) and
            (0 < Y) and (Y <= H)
        Then Exit(X + (Y-1) * W)
        Else Exit(0);				// для некорректных координат
  End;

// ...

  Function FindLocation (Const Mark : TMap;  Var S : TCrd): Boolean;
  Var
    X, Y        : Word;
  Begin
    For X:=1 To W
      Do For Y:=1 To H Do Begin
        S := Crd(X, Y);
        If Mark[S]
          Then Exit(True);
      End;
    Exit(False);
  End;

  Function IsConnected (Const Map : TMap): Boolean;
  Var
    Mark        : TMap;
    Q           : Array [1..MaxM] of TCrd;
    P, Dxy      : TCrd;
    BQ, EQ      : LongWord;
  Begin
    Mark := Map;
    BQ := 0;
    EQ := 1;
    If not FindLocation(Map, Q[1])
      Then Exit(False);
    Mark[ Q[1] ] := False;
    While BQ < EQ Do Begin
      Inc(BQ);
      For Dxy in Steps Do Begin
        P := Q[BQ] + Dxy;
        If not Mark[P]
          Then Continue;
        Mark[P] := False;
        Inc(EQ);
        Q[EQ] := P;
      End;
    End;
    Exit(CountSet(Mark) = 0);
  End;
  
// ...

  Procedure Check();
  Var
    i   : Byte;
  Begin
    For i:=1 To N
      Do CAssert(IsConnected(Sol[i-1]), 'Shape %d is not connected', [i]);
    CAssert(Combinations(Sol) = 2**N, 'Not all combinations are present');
    Succeed();
  End;

BEGIN
  ReadAll(@ReadIn, Nil, @ReadOut);
  Check();
END.

Msk2014 A (подзадачи, множества)
{$Mode ObjFPC}
Uses
  DLChecker;

CONST
  Penalty = 10;

VAR
  Subtask               : AnsiString;
  ChkAlways, ChkOften,
  OutAlways, OutOften   : TStrings;

  Procedure ReadChk ();
  Begin
    Subtask := GetSubtask('1 2');		// первая строка - "#1" или "#2"
    ChkAlways := Strings( ReadSplit() );	// слова через пробел
    ChkOften  := Strings( ReadSplit() );
  End;

  Procedure ReadOut ();
  Begin
    OutAlways := Strings( ReadSplit() );
    OutOften  := Strings( ReadSplit() );
  End;

  Procedure Check();
  
    Function Diff (Chk, Out : TStrings): LongWord;
    Var
      Used      : TStringSet;
    Begin
      Used.Create(Chk, True);
      Used.KeepAll(Out);
      Exit(Chk.Length + Out.Length - 2*Used.Size)
    End;
  
  Var
    Mistakes  : LongWord;
  Begin
    Mistakes := Diff(ChkAlways, OutAlways) + Diff(ChkOften, OutOften);
    ScoreTest(Penalty, Mistakes, Subtask = '2');	// в подзадаче #2 - частичная оценка
  End;

BEGIN
  ReadAll(Nil, @ReadChk, @ReadOut);
  Check();
END.

Msk2015 F (векторы и словари)
{$Mode ObjFPC}
Uses
  DLChecker, SysUtils, Math;

TYPE
  TWordKind = (w_Noun, w_Verb, w_Adjective);
  TLengths  = Array [TWordKind] of Int64;
  TWordInfo = Record
    Kind        : TWordKind;
    Importance  : Byte;
  End;
  TDict  = Specialize GDict<AnsiString, TWordInfo>;
  TInput = Record
    Dict                : TDict;
    MinSize, MaxSize    : LongWord;
  End;
  TInputs = Specialize GVector<TInput>;

CONST
  Invalid = -1;

VAR
  Inputs        : TInputs;
  Ans, Sol      : TStrings;
  Partial       : Word;

  Function ReadWord (Kind : TWordKind): TDict._I;
  Var
    WI  : TWords;
  Begin
    With Result Do Begin
      WI := ReadSplit();
      Key := WI[0];
      Value.Kind := Kind;
      Value.Importance := StrToInt(WI[1]);	// читаем из InFile => ограничения не проверяем
    End;
  End;

  Function ReadDict (Const Len : TLengths): TDict._Items;
  Var
    M, j        : LongWord;
    Kind        : TWordKind;
  Begin
    SetLength(Result, SumInt(Len));
    M := 0;
    For Kind in TWordKind
      Do For j:=1 To Len[Kind] Do Begin
        Result[M] := ReadWord(Kind);
        Inc(M);
      End;
  End;

  Function ReadInput (): TInput;
  Var
    L   : TLengths;
  Begin
    With Result Do Begin
      ReadLn(L[w_Noun], L[w_Verb], L[w_Adjective]);
      Dict.Clone(ReadDict(L), @CompareText);
      ReadLn(MinSize, MaxSize);
    End;
  End;

  Procedure ReadIn ();
  Var
    T   : LongWord;
  Begin
    ReadLn(T);
    Inputs.Generate(T, @ReadInput);		// читаем T test case'ов в вектор
  End;

  Procedure ReadChk ();
  Begin
    Partial := ParseUInt(GetSubtask(), MaxPoints);
    Ans.Generate(Inputs.Length, @ReadString);	// читаем T строк в вектор
  End;

  Procedure ReadOut ();
  Begin
    Sol.Generate(Inputs.Length, @ReadString);
  End;

  Procedure MarkWord (Var B : Boolean);		// Upd для Dict.Apply
  Begin
    CAssert(not B, 'Word already used!');	// дополнительная проверка на дублирование
    B := True;
  End;

  Procedure NoWord ();				// Fail для Dict.Apply
  Begin
    RageExit('Unknown word');
  End;

  Procedure Check();
  
    Function Calc (Const Line : AnsiString;  Const TestCase : TInput): LongInt;
    Var
      Used              : TStringBools;		// не TStringSet, чтобы добавить функционал
      Sentence, Word, S : AnsiString;
      N, V              : LongWord;
      LastAdj           : Boolean;
      Size              : LongWord;
    Begin
      With TestCase Do Begin
        CAssert((Line <> '') and (Line[Length(Line)] = '.'), 'Invalid line');
        Used.CreateReset(TStrings(Dict.GetKeys), False);
        Result := 0;
        For Sentence in Split(' '+Line, '.') Do Begin
          N := 0;
          V := 0;
          LastAdj := False;
          S := Copy(Sentence, 3, Length(Sentence));
          CAssert((Length(Sentence) > 1) and (Sentence[1] = ' ') and
                  (UpCase(Sentence[2]) = Sentence[2]) and
                  (LowerCase(S) = S), 'Bad formatting');
          For Word in Split(Sentence) Do Begin
            Used.Apply(Word, @MarkWord, @NoWord);
            With Dict[Word] Do Begin
              Inc(Result, Importance);
              Case Kind of
                w_Noun : Begin
                  LastAdj := False;
                  Inc(N);
                End;
                w_Verb: Begin
                  CAssert(not LastAdj, 'LastAdj');
                  Inc(V);
                End;
                Else
                  CAssert(not LastAdj, 'LastAdj');
                  LastAdj := True;
              End;
            End;
          End;
          CAssert((V = 1) and (N > 0) and not LastAdj, 'Invalid sentence');
        End;
        Size := CountSet(Used.RawValues.RawData);
        If (MinSize > Size) or (Size > MaxSize)
          Then Exit(Invalid);
      End;
    End;
  
  Var
    Score, N, i : Word;
  Begin
    N := Inputs.Length;
    Score := 0;
    For i:=1 To N
      Do Count(Score, Calc(Ans[i], Inputs[i]) = Calc(Sol[i], Inputs[i]));
    If Score = N
      Then Succeed();
    CAssert(Partial > 0, WrongAnswer);
    Succeed(Partial * Score div N, '%d/%d', [Score, N]);
  End;

BEGIN
  ReadAll(@ReadIn, @ReadChk, @ReadOut);
  Check();
END.
Powered by Atlassian Confluence, the Enterprise Wiki. (Version: http://www.atlassian.com/software/confluence Build:#2.6.1 916) - Ошибка/новая особенность - Свяжитесь с Администраторами