ЗАДАЧА №1. ПРОСТЫЕ ЧИСЛА.
Вывести все простые числа от M до N включительно.
Ограничения: 2≤M≤N≤300000, время 6 с.
Ввод из файла primes.in. В первой строке находятся разделенные пробелом M и N.
Вывод в текстовое поле. Вывести числа в порядке возрастания, по одному в строке. Если между M и N включительно нет простых - вывести "Absent".
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //Весь входной файл будет содержаться здесь
a,b : LongInt; //Здесь будут содержаться 2 входных числа
i,k : LongInt; //Счетчики циклов
_SN : Boolean; //Содержит информацию о типе числа
begin
all := TStringList.Create;
if FileExists('primes.in') then
all.LoadFromFile('primes.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
all.Delimiter := ' ';
all.DelimitedText := all.Strings[0];
a := StrToInt(all.Strings[0]);
b := StrToInt(all.Strings[1]);
all.Free;
if a < 2 then begin
ShowMessage('Первое число меньше 2!');
Close;
end;
if b > 300000 then begin
ShowMessage('Второе число больше 300.000!');
Close;
end;
for i := a to b do begin
_SN := true;
for k := 2 to trunc(sqrt(i)) do begin
if (i mod k) = 0 then begin
_SN := false;
break;
end;
end;
if _SN then Memo1.Lines.Add(IntToStr(i));
end;
if Memo1.Lines[0] = '' then Memo1.Lines.Add('Absent');
end;
end.
ЗАДАЧА №2. ВОЗРАСТАЮЩАЯ ПОДПОСЛЕДОВАТЕЛЬНОСТЬ.
Даны N целых чисел X1, X2, ..., XN. Требуется вычеркнуть из них минимальное количество чисел так, чтобы оставшиеся шли в порядке возрастания.
Ограничения: 1≤N≤10000, 1≤Xi≤60000, время 4 с.
Ввод из файла incseq.in В первой строке находится число N. В следующей строке - N чисел через пробел.
Вывод в текстовое поле. В первой строке выводится количество невычеркнутых чисел, во второй - сами невычеркнутые числа через пробел в исходном порядке. Если вариантов несколько, вывести любой.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //Входной файл
s : String; //Временная строка для хранения готовой последовательности
N : Word; //Количество исходных чисел
max : Word; //Максимальная длина подпоследовательности
max_i : Word; //Максимальный индекс элемента наибольшей подпоследовательности
i,j : Word; //Счетчики для циклов
A,B,C : array of Word; //Массивы для последовательностей, память еще не выделена
begin
all := TStringList.Create;
if FileExists('incseq.in') then
all.LoadFromFile('incseq.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
N := StrToInt(all.Strings[0]);
if (N < 1) or (N > 10000) then begin
ShowMessage('Количество чисел N не удовлетворяет условию 1 <= N <= 10000!');
Close;
end;
all.Delimiter := ' ';
all.DelimitedText := all.Strings[1];
SetLength(A, N);
for i := 0 to N-1 do
A[i] := StrToInt(all.Strings[i]);
all.Free;
SetLength(B, N);
for i := 0 to N-1 do
B[i] := 1;
SetLength(C,N);
for i := 0 to N-1 do
C[i] := 0;
max := 1; max_i := 1;
for i := 0 to N-1 do begin
for j := 0 to N-1 do begin
if i = j then break;
if (A[j]<a[i]) and="" (b[i]<b[j]+1)="" then="" begin="" b[i]="" :="B[j]" +="" 1;="" c[i]="" if="">max then begin
max := B[i];
max_i := i;
end;
end;
end;
end;
Memo1.Lines.Add(IntToStr(B[max_i]));
s := ''; i := 0;
while max_i <> 0 do begin
i := i + 1;
s := IntToStr(A[max_i]) + ' ' + s;
max_i := C[max_i];
end;
if i < max then
Memo1.Lines.Add(IntToStr(A[0]) + ' ' + s)
else
Memo1.Lines.Add(s);
end;
end.</a[i])>
ЗАДАЧА №3. ТРЕУГОЛЬНИК И ТОЧКА.
В декартовой системе координат на плоскости заданы координаты вершин треугольника и еще одной точки. Определить, принадлежит ли эта точка треугольнику.
Ограничения: координаты вершин - целые числа, для любой точки выполняются следующие условия: -10000≤x,y≤10000, время 1 с.
Ввод из файла tria-pt.in. В четырех строках находятся пары чисел - координаты вершин треугольника, в четвертой строке - координаты тестируемой точки.
Вывод в текстовое поле. Вывести слово In, если точка находится внутри треугольника, или Out - если снаружи.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{Функция нахождения расстояния между вершинами треугольника}
function _distance(x1,y1,x2,y2:Real):Real;
begin
result := sqrt(sqr(x1-x2)+sqr(y1-y2));
end;
{----------------------------------------------------------}
{Функция вычисления площади треугольника по Формуле Герона}
function _square(x1,y1,x2,y2,x3,y3:Real):Real;
var
p,a,b,c : Real; //Длины сторон и полупериметр
begin
a := _distance(x3,y3,x2,y2);
b := _distance(x1,y1,x3,y3);
c := _distance(x1,y1,x2,y2);
p := (a+b+c)/2;
result := sqrt(p*(p-a)*(p-b)*(p-c));
end;
{----------------------------------------------------------}
{Функция определения принадлежности точки треугольнику}
function _pointIn(x1,y1,x2,y2,x3,y3,x,y:Real):Boolean;
{x,y - координаты точки
x1-x3, y1-y3 - координаты вершин заданного треугольника}
const
corr = 0.000001;
var
s,s1,s2,s3 : Real; //Площади всех 4 треугольников
begin
_pointIn := true;
s := _square(x1,y1,x2,y2,x3,y3);
s1 := _square(x1,y1,x2,y2,x,y);
s2 := _square(x2,y2,x3,y3,x,y);
s3 := _square(x3,y3,x1,y1,x,y);
if ((s+corr) > (s1 + s2 + s3)) then
_pointIn := true
else
_pointIn := false;
end;
{----------------------------------------------------------}
procedure TForm1.FormShow(Sender: TObject);
var
Ax,Bx,Cx : Real; //Абсциссы вершин заданного треугольника ABC
Ay,By,Cy : Real; //Ординаты вершин заданного треугольника ABC
Dx,Dy : Real; //Координаты точки D
all : TStringList; //Входной файл
temp : TStringList; //Временная переменная - строка с координатами одной из точек
begin
all := TStringList.Create;
if FileExists('tria-pt.in') then
all.LoadFromFile('tria-pt.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
temp := TstringList.Create;
with temp do begin
Delimiter := ' ';
Add(all.Strings[0]);
DelimitedText := Strings[0];
Ax := StrToFloat(Strings[0]);
Ay := StrToFloat(Strings[1]);
Clear;
Add(all.Strings[1]);
DelimitedText := Strings[0];
Bx := StrToFloat(Strings[0]);
By := StrToFloat(Strings[1]);
Clear;
Add(all.Strings[2]);
DelimitedText := Strings[0];
Cx := StrToFloat(Strings[0]);
Cy := StrToFloat(Strings[1]);
Clear;
Add(all.Strings[3]);
DelimitedText := Strings[0];
Dx := StrToFloat(Strings[0]);
Dy := StrToFloat(Strings[1]);
end;
temp.Free;
all.Free;
if _pointIn(Ax,Ay,Bx,By,Cx,Cy,Dx,Dy) then
Memo1.Lines.Add('In')
else
Memo1.Lines.Add('Out');
end;
end.
ЗАДАЧА №4. СТЕПЕНЬ.
Для натуральных чисел a и n вычислить an.
Ограничения: 1≤a≤9, 1≤n≤7000, время 5 с.
Ввод из файла power.in. В первой строке находятся разделенные пробелом a и n.
Вывод в текстовое поле. Выводится одно число - результат без стоящих впереди нулей, стоящих впереди и позади пробелов.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //Входной файл
a : Byte; //Число, которое будет возводиться в степень (основание)
n : Word; //Степень, в которую возводится число (показатель)
i,j : Word; //Счетчики для циклов
carry : Byte; //Переход в старший разряд
len : Word; //Текущая длина промежуточного числа
digit : array of Byte; //Массив с цифрами будущего числа, память еще не выделена
s : String; {Строка для хранения получившегося числа. Если
сразу выводить в Memo, то это вызывает большую задержку по времени и если
возводить в большую степень(~500..7000) - некорректное отображение конечного числа}
begin
all := TStringList.Create;
if FileExists('power.in') then
all.LoadFromFile('power.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
all.Delimiter := ' ';
all.DelimitedText := all.Strings[0];
try
a := StrToInt(all.Strings[0]);
n := StrToInt(all.Strings[1]);
except
ShowMessage('Неверный формат входного файла!');
Close;
end;
all.Free;
if (a<1) or (a>9) then begin
ShowMessage('Основание не удовлетворяет условию 1<=a<=9!');
Close;
end;
if (n<1) or (n>7000) then begin
ShowMessage('Показатель степени не удовлетворяет условию 1<=n<=7000 !');
Close;
end;
SetLength(digit,1);
digit[0] := 1;
len := 0;
for i := 1 to n do begin
carry := 0;
for j := 0 to len do begin
carry := carry + digit[j]*a;
digit[j] := carry mod 10;
carry := carry div 10;
end;
if carry <> 0 then begin
len := len + 1;
SetLength(digit,len+1);
digit[len] := carry;
end;
end;
for i := length(digit) downto 1 do
s := s + IntToStr(digit[i-1]);
Memo1.Lines.Add(s);
end;
end.
ЗАДАЧА №5. ПОКЕР.
Даны пять целых чисел. Среди них:
- если одинаковы 5, то вывести "Impossible", иначе;
- если одинаковы 4, то вывести "Four of a Kind", иначе;
- если одинаковы 3 и 2, то вывести "Full House", иначе;
- если есть 5 последовательных, то вывести "Straight", иначе;
- если одинаковы 3, то вывести "Free of a Kind", иначе;
- если одинаковы 2 и 2, то вывести "Two Pairs", иначе;
- если одинаковы 2, то вывести "One Pair", иначе;
- вывести "Nothing".
Ограничения: все числа от 1 до 13 включительно, время 1 с.
Ввод из файла poker.in. В первой строке находятся пять чисел через пробел.
Вывод в текстовое поле. Выводится одна строка - результат анализа.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //Входной файл
i,j : Byte; //Счетчики
_s : Byte; //Начальная позиция комбинации "Straight"
A : array [1..5] of Byte; //Массив с исходными числами
B : array [1..13] of Byte; //Сколько раз значение j содержится в массиве A
C : array [0..2] of Byte; //Сколько и каких совпадений есть в массиве B
{
Уточнение для массива C:
C[0] - пара
C[1] - сет, трипс, три одинаковые карты
C[2] - каре, четыре одинаковых карты
----------------------------------------
C[0]=1 - Pair, C[0]=2 - Two Pair
C[1] - Free Of A Kind, может принимать только значение 0 или 1
C[2] - Four Of A Kind, может принимать только значение 0 или 1
}
begin
all := TStringList.Create;
if FileExists('poker.in') then
all.LoadFromFile('poker.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
all.Delimiter := ' ';
all.DelimitedText := all.Strings[0];
for i := 0 to 4 do begin
try
A[i+1] := StrToInt(all.Strings[i]);
except
ShowMessage('Неверный формат входного файла!');
Close;
end;
if A[i+1]>13 then begin
ShowMessage('Неверный формат входного файла!');
Close;
end;
if A[i+1]<1 then begin
ShowMessage('Неверный формат входного файла!');
Close;
end;
end;
all.Free;
if (A[1]=A[2]) and
(A[1]=A[3]) and
(A[1]=A[4]) and
(A[1]=A[5]) then
Memo1.Lines.Add('Impossible');
for j := 1 to 13 do
B[j] := 0;
for i := 1 to 5 do
for j := 1 to 13 do
if A[i] = j then
B[j] := B[j] + 1;
for i := 1 to 13 do
if B[i] = 1 then begin
_s := i; break;
end;
if (B[_s]=1) and
(B[_s+1]=1) and
(B[_s+2]=1) and
(B[_s+3]=1) and
(B[_s+4]=1) then
Memo1.Lines.Add('Straight');
for j := 0 to 2 do
C[j] := 0;
for i := 1 to 13 do begin
case B[i] of
2: C[0] := C[0] + 1; //пары
3: C[1] := C[1] + 1; //сет
4: C[2] := C[2] + 1; //каре
end;
end;
with Memo1.Lines do begin
if (C[0]=1) and (C[1]=0) then Add('Pair');
if (C[0]=2) then Add('Two Pair');
if (C[0]=0) and (C[1]=1) then Add('Free Of A Kind');
if (C[0]=1) and (C[1]=1) then Add('Full House');
if (C[2]=1) then Add('Four Of A Kind');
end;
if Memo1.Lines[0] = '' then
Memo1.Lines.Add('Nothing');
end;
end.
ЗАДАЧА №6. ИГРА "ДАТЫ".
Играют двое. Задается какая-то дата 2004 года. Каждый игрок на своем ходе называет более позднюю дату, увеличивая на 1 или 2 либо день в месяце, либо месяц, но не то и другое сразу. При этом сочетание дня и месяца должно оставаться датой. Игрок, назвавший 31 декабря, проигрывает. Оба играют наилучшим образом. Исходя из заданной даты, вывести, кто выиграет.
Ограничения: месяц от 1 до 12, день от 1 числа до числа дней в месяце, даты "31 декабря" во входных данных нет, время 1 с.
Ввод из файла dategame.in. В первой строке находятся разделенные пробелом числа, обозначающие день и месяц.
Вывод в текстовое поле. Вывести 1, если выиграет первый (начинающий) игрок, или 2 - в противном случае.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function _winPos(day, month : Byte): ShortInt;
var
year : array [1..31, 1..12] of ShortInt;
{1 - если позиция выигрышная, 0 - проигрышная, -1 - такого дня не существует}
i,j : Byte; //Счетчики для циклов
predDAY : ShortInt; //Зачение вчерашнего числа
ppredDAY : ShortInt; //Значение позавчерашнего числа
predMONTH : ShortInt; //Значение того же числа в предыдущем месяце
ppredMONTH : ShortInt; //Значение того же числа 2 месяца назад
begin
year[31,12] := -1; //31 декабря не задается начальной датой
year[31,11] := -1; //31 ноября не существует
year[31, 9] := -1; //31 сентября не существует
year[31, 6] := -1; //31 июня не существует
year[31, 4] := -1; //31 апреля не существует
year[31, 2] := -1; //31 февраля не существует
year[30, 2] := -1; //30 февраля не существует
predDAY := 1;
ppredDAY := 1;
for i := 12 downto 1 do begin
for j := 31 downto 1 do begin
if year[j,i] = -1 then
continue
else begin
case i of
12 : begin
if (ppredDAY=0) and (predDAY=1) then year[j,i] := 1;
if (ppredDAY=1) and (predDAY=1) then year[j,i] := 0;
if (ppredDAY=1) and (predDAY=0) then year[j,i] := 1;
end;
11 : begin
predMONTH := year[j,12];
if predMONTH=0 then year[j,i] := 1
else begin
if (ppredDAY=0) and (predDAY=1) then year[j,i] := 1;
if (ppredDAY=1) and (predDAY=1) then year[j,i] := 0;
if (ppredDAY=1) and (predDAY=0) then year[j,i] := 1;
end;
end;
1..10 : begin
predMONTH := year[j,i+1];
ppredMONTH := year[j,i+2];
if (ppredMONTH=0) or (predMONTH=0) then year[j,i] := 1
else begin
if (ppredDAY=0) and (predDAY=1) then year[j,i] := 1;
if (ppredDAY=1) and (predDAY=1) then year[j,i] := 0;
if (ppredDAY=1) and (predDAY=0) then year[j,i] := 1;
end;
end;
end;
ppredDAY := predDAY;
predDAY := year[j,i];
end;
end;
end;
_winPos := year[day,month];
end;
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //Входной файл
day, month : Byte; //Заданные, начальные месяц и день
begin
all := TStringList.Create;
if FileExists('dategame.in') then
all.LoadFromFile('dategame.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
all.Delimiter := ' ';
all.DelimitedText := all.Strings[0];
day := StrToInt(all.Strings[0]);
month := StrToInt(all.Strings[1]);
all.Free;
{//Для тестирования работоспособности функции _winPos:
//ввести переменные j : Byte; s : string;
for j := 31 downto 1 do
s := s + (IntToStr(j) + '.2 = ' + IntToStr(_winPos(j,2)) + '******');
Memo1.Lines.Add(s); }
if _winPos(day,month) = -1 then begin
ShowMessage('Дата задана некорректно!');
Close;
end;
if _winPos(day,month) = 0 then
Memo1.Lines.Add('Выиграет второй игрок');
if _winPos(day,month) = 1 then
Memo1.Lines.Add('Выиграет первый игрок');
end;
end.
ЗАДАЧА №7. СЛОВАРЬ.
У Васи на клавиатуре не работает клавиша пробел. Поэтому все тексты он теперь набирает слитно. Напишите программу, которая будет разделять набранный Васей текст на слова из данного словаря.
Ввод программы поступает текст, введенный Васей - одна строка из не более чем 100 латинских строчных букв. В следующей строке входных данных задается значение N - количество слов в словаре (N - натуральное число, не превосходящее 2000). В следующих N строках записаны слова из словаря - по одному слову в строке, каждое слово содержит не более 20 латинских строчных букв. Слова записаны в алфавитном порядке.
Вывод Васин текст с пробелами между словами (пробел после последнего слова допустим). Если возможно несколько вариантов разбиения строки на слова, выведите любой их них. Гарантируется, что хотя бы один способ разбиения строки на словарные слова существует.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, XPMan;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
XPManifest1: TXPManifest;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
all : TStringList; //весь текст, который мы читаем из файла
vasya : String; //текст без пробелов, который набрал Василий, это первая строка
temp : String; //временная строка для сравнения во время перебора
N : Word; //число слов в словаре, вторая строка файла
i,j,k : Word; //счетчики
words : array of String; //массив со всеми словами словаря; пока его размер неизвестен; память для него не выделена
begin
all := TStringList.Create;
if FileExists('in.in') then
all.LoadFromFile('in.in')
else begin
ShowMessage('Входной файл не найден!');
Close;
end;
vasya := all.Strings[0];
N := StrToInt(all.Strings[1]);
SetLength(words, all.Count - 2);
{--------------------------Обработка ошибок во входящем файле-------------------------}
if length(vasya) > 100 then begin
ShowMessage('Длина Васиной строки превышает 100 символов');
Close;
end;
if (N > 2000) and (length(words) > 2000) then begin
ShowMessage('Превышено допустимое количество слов в словаре, ограничение: 2000');
Close;
end;
if N <> length(words) then begin
ShowMessage('Число слов в словаре отличается от указанного во второй строке входящего файла!');
Close;
end;
{-------------------------------------------------------------------------------------}
for i := 2 to (all.Count - 1) do begin
words[i-2] := all.Strings[i];
end;
all.Free;
j := 1; k := 1;
while k < length(vasya) do begin
temp := copy(vasya, j, k);
for i := 0 to (length(words) - 1) do begin
if temp = words[i] then begin
Memo1.Lines[0] := Memo1.Lines[0] + words[i] + ' ';
j := j + k; k := 0;
break;
end;
end;
k := k + 1;
if (j < length(vasya)) and (k = length(vasya)) then begin
j := j + 1; k := 1;
end;
end;
end;
end.
Ср Янв 09, 2013 9:10 am
