- •Олимпиадные задачи и решения
- •Векторы (100 баллов)
- •Погодные условия (100 баллов)
- •Шоколадные плитки (100 баллов)
- •Работники (100 баллов)
- •Робот (100 баллов)
- •Зал Круглых Столов (100 баллов)
- •Вто (100 баллов)
- •Вишня (100 баллов)
- •Алхимия (100 баллов)
- •Цепь (100 баллов)
- •Казино (100 баллов)
- •Система уравнений (100 баллов)
- •Забавный конфуз
- •Соревнование
- •Абракадабра
- •Циферблат
- •Многоугольники
- •Квадрат
- •Лабиринт
- •Задача “Шифр”
- •Задача “Школы”
- •Последовательность
- •Автобус
- •Головоломка
- •Электронная почта
- •Виртуляндия
- •Конвейер
- •Новости
Цепь (100 баллов)
Есть N кусков цепи, каждый i-й из которых содержит Li звеньев. Можно разгибать произвольные звенья и потом сгибать их снова, соединяя отдельные куски.
Задание
Напишите программу CHAIN, которая по количеству кусков цепи N и количеству звеньев в кусках Li определяет минимальное количество звеньев, которые нужно разогнуть и согнуть снова, чтобы соединить все куски в одну цепь. Цепь не может иметь разветвлений, т.е. каждое звено должно быть соединено с двумя звеньями (кроме двух звеньев по краям цепи, которые должны быть соединены только с одним звеном).
Входные данные
В первой строке входного файла CHAIN.DAT находится целое число N (2N10 000). Во второй строке находятся N целых чисел Li (1Li1 000 000 000).
Выходные данные
В единственной строке выходного файла CHAIN.SOL должно находится целое число — наименьшее количество звеньев, которые необходимо разогнуть и согнуть снова, чтобы получить одну цепь из всех кусков.
Пример входных и выходных данных
CHAIN.DAT |
CHAIN.SOL |
3 100 3 4 |
2 |
{ Problem: CHAIN}
const
maxN=10000;
Inf=maxN-1;
type
list = array[1..maxN] of word;
procedure heapsort(var a: list; N: word);
var
i:word;
procedure Xch(i,j:word);
var
temp:word;
begin
temp:=a[i];
a[i]:=a[j];
a[j]:=temp;
end;
procedure Heapify(what:word);
var
max:word;
begin
while what*2<=N do
begin
max:=what;
if a[what*2]>a[max] then
max:=what*2;
if (what*2+1<=N)AND
(a[what*2+1]>a[max]) then
max:=what*2+1;
if max=what then
what:=n
else
begin
Xch(what,max);
what:=max;
end;
end;
end;
begin
for i:=N div 2 downto 1 do
Heapify(i);
i:=N;
while N>1 do
begin
Xch(1,N);
Dec(N);
Heapify(1);
end;
N:=i;
end;
var
kuski:list;
s,N,M,i:word;
fi,fo:text;
temp:longint;
begin
assign(fi,'chain.dat');
assign(fo,'chain.sol');
reset(fi);
rewrite(fo);
readln(fi,N);
for i:=1 to N do
begin
read(fi,temp);
if temp>=Inf then
kuski[i]:=Inf
else
kuski[i]:=temp;
end;
heapsort(kuski,N);
s:=0;
i:=1;
M:=0;
while s+kuski[i]<N-i do
begin
Inc(M);
s:=s+kuski[i];
Inc(i);
end;
writeln(fo,N-M-1);
close(fi);
close(fo);
end.
Казино (100 баллов)
В верхнем левом углу прямоугольного поля размерами NM размещается игральний кубик, разворот которого изображен на рисунке. Кубик ориентирован так, что передней грани соответствует единица, а слева находится грань, которой соответствует двойка. Клетки поля квадратные, их размеры совпадают с размерами грани кубика.
Кубик может двигаться по полю, переворачиваясь через одно из ребер, и попадать при этом в соседнюю снизу, сверху, справа или слева клетку поля. Например, если из начального состояния кубик двигается направо, то передней станет грань с двойкой, а если вниз — то с тройкой. Кубик не может выходить за пределы поля.
Задание
Напишите программу CASINO, которая по информации о поле находит один из возможных путей кубика из верхнего левого угла в нижний правый угол поля. При этом необходимо найти такой путь, чтобы передняя грань кубика в целевой клетке имела максимальное возможное значение. Кубик может посещать каждую клетку поля несколько раз.
Входные данные
Первая строка входного файла CASINO.DAT содержит два натуральных числа N и M (2N, M50), которые определяют высоту и ширину поля соответственно. Далее задается поле, которое представлено N строками, каждая из которых состоит из M чисел, каждое из которых равно 0 либо 1. В случае, когда клетке поля соответствует число 1, кубику запрещено посещать данную клетку. В противном случае эта клетка может встречаться в пути кубика. Начальной клетке всегда соответствует число 0.
Выходные данные
Первая строка выходного файлаCASINO.SOL должна содержать натуральное число W — длину найденого пути. Далее в файле должны находиться W строк, каждая из которых задает координату клетки поля на текущем шаге. Координата представляет собой пару натуральных чисел: номер строки и номер столбца клетки поля.
В случае, когда искомого пути не существует, выходной файл должен содержать строку с числом -1.
Пример входных и выходных данных
CASINO.DAT |
CASINO.SOL |
3 2 0 1 0 0 0 0 |
3 2 1 2 2 3 2 |
{ Problem: CASINO}
program casino;
const
MAX_N = 50; {maximum field size}
STATE_NUM = 24; {the number of possible brick positions}
FILE_IN = 'casino.dat';
FILE_OUT = 'casino.sol';
type
TDirection = (DIR_UP, DIR_RIGHT, DIR_DOWN, DIR_LEFT);
TState = byte; {1..STATE_NUM;}
TPosition = record
row : byte;
column : byte;
end;
TMarks = array[1..STATE_NUM] of boolean;
const
States : array[1..STATE_NUM, 1..2] of integer = (
{ 1} (1,2), { 2} (1,3), { 3} (1,4), { 4} (1,5),
{ 5} (2,1), { 6} (2,3), { 7} (2,4), { 8} (2,6),
{ 9} (3,1), {10} (3,2), {11} (3,5), {12} (3,6),
{13} (4,1), {14} (4,2), {15} (4,5), {16} (4,6),
{17} (5,1), {18} (5,3), {19} (5,4), {20} (5,6),
{21} (6,2), {22} (6,3), {23} (6,4), {24} (6,5)
);
Sides : array[1..6, 1..4] of integer = (
(2, 3, 5, 4),
(1, 4, 6, 3),
(1, 2, 6, 5),
(1, 5, 6, 2),
(1, 3, 6, 4),
(2, 4, 5, 3)
);
type
TQueueElement = record
pos : TPosition;
state : TState;
prev : Word;
end;
PQueueElement = ^TQueueElement;
TVec = array[1..5] of TQueueElement;
TQueue = array[1..MAX_N*MAX_N*STATE_NUM div 5] of ^TVec;
var
n : Integer; {field height}
m : Integer; {field width}
field : array[1..MAX_N, 1..MAX_N] of Boolean;
waves : array[1..MAX_N, 1..MAX_N] of TMarks;
pqueue : ^TQueue;
qSize : Integer;
qCurr : Integer;
currSolId : integer;
solFound : Boolean;
{-------------------------------------------------------------}
{Dynamic init}
procedure DynInit;
var
i : integer;
begin
new(pqueue);
for i:=1 to MAX_N*MAX_N*STATE_NUM div 5 do
new(pqueue^[i]);
end;
{Dynamic dispose}
procedure DynDispose;
var
i : integer;
begin
for i:=1 to MAX_N*MAX_N*STATE_NUM div 5 do
Dispose(pqueue^[i]);
Dispose(pqueue);
end;
{Dynamic work}
procedure GetQueueElement(x : Word; var ppos : PQueueElement);
begin
ppos := @pqueue^[ ( (x-1) div 5 ) + 1 ]^[ ( (x-1) mod 5 ) + 1];
end;
{=============================================================}
procedure Init;
var
fin : Text;
i, j : Integer;
value : Integer;
begin
Assign(fin, FILE_IN);
Reset(fin);
ReadLn(fin, n, m);
FillChar(waves, sizeof(waves), false);
for i:=1 to n do
begin
for j:=1 to m do
begin
Read(fin, value);
if value = 0
then field[i,j]:=true
else field[i,j]:=false;
end;
end;
Close(fin);
solFound := false;
currSolId := 0;
DynInit;
end;
function CanMove(pos : TPosition; dir : TDirection) : boolean;
begin
CanMove := false;
if (pos.row = 1) and (dir = DIR_UP) then exit;
if (pos.row = n) and (dir = DIR_DOWN) then exit;
if (pos.column = 1) and (dir = DIR_LEFT) then exit;
if (pos.column = m) and (dir = DIR_RIGHT) then exit;
if (dir = DIR_UP) and (not field[pos.row-1, pos.column]) then exit;
if (dir = DIR_DOWN) and (not field[pos.row+1, pos.column]) then exit;
if (dir = DIR_LEFT) and (not field[pos.row, pos.column-1]) then exit;
if (dir = DIR_RIGHT) and (not field[pos.row, pos.column+1]) then exit;
CanMove := true;
end;
procedure GetStateByPair(up, left : integer; var state : TState);
var
i : integer;
begin
for i:=1 to STATE_NUM do
if (States[i,1] = up) and (States[i,2] = left) then
begin
state := i;
exit;
end;
end;
function CubeSide(upper, side, many : integer) : integer;
var
i : integer;
begin
for i:=1 to 4 do
if Sides[upper, i] = side then
break;
if (i+many) mod 4 = 0
then CubeSide := Sides[upper, 4]
else CubeSide := Sides[upper, (i+many) mod 4];
end;
procedure MoveBrick(var state : TState; dir : TDirection);
var
up, left : integer;
nu, nl : integer;
begin
up := States[state, 1];
left := States[state, 2];
case dir of
DIR_UP :
begin
nl:=left;
nu:=CubeSide(left,up,1);
end;
DIR_RIGHT :
begin
nl:=CubeSide(left,up,2);
nu:=left;
end;
DIR_LEFT :
begin
nl:=up;
nu:=CubeSide(up,left,2);
end;
DIR_DOWN :
begin
nl:=left;
nu:=CubeSide(left,up,3);
end;
end;
GetStateByPair(nu, nl, state);
end;
procedure Move(var pos : TPosition; var state : TState; dir : TDirection);
begin
case dir of
DIR_UP : Dec(pos.row);
DIR_RIGHT : Inc(pos.column);
DIR_LEFT : Dec(pos.column);
DIR_DOWN : Inc(pos.row);
end;
MoveBrick(state, dir);
end;
procedure Run;
var
dir : TDirection;
pos, newPos : TPosition;
state, newState : TState;
pqe, pqe1, pqe2, pqe3 : PQueueElement;
begin
GetQueueElement(1, pqe);
pqe^.pos.row:=1;
pqe^.pos.column:=1;
pqe^.state:=1;
pqe^.prev:=0;
qSize:=1;
qCurr:=1;
waves[1,1][1] := true;
while ((qSize>=qCurr) and (not solFound)) do
begin
GetQueueElement(qCurr, pqe1);
pos := pqe1^.pos;
state := pqe1^.state;
for dir:=DIR_UP to DIR_LEFT do
if CanMove(pos, dir) then
begin
newPos := pos;
newState := state;
Move(newPos, newState, dir);
if not waves[newPos.row, newPos.column][newState] then
begin
{ Add the element to the queue }
Inc(qSize);
waves[newPos.row, newPos.column][newState] := true;
GetQueueElement(qSize, pqe2);
pqe2^.prev := qCurr;
pqe2^.pos := newPos;
pqe2^.state := newState;
end;
if (currSolId<>0) then
GetQueueElement(currSolId, pqe3);
if ((currSolId = 0) or (newState > pqe3^.state)) and
(newPos.row = n) and
(newPos.column = m) then
begin
currSolId := qSize;
if newState >= 21 then
begin
{ Solution has been found }
solFound := true;
exit;
end;
end;
end;
Inc(qCurr);
end;
if currSolId <> 0 then
solFound := true;
end;
procedure Done;
var
fout : Text;
number : integer;
prev, curr, next : integer;
i : integer;
pqe : PQueueElement;
begin
Assign(fout, FILE_OUT);
Rewrite(fout);
if not solFound then
WriteLn(fout, '-1')
else
begin
GetQueueElement(currSolId, pqe);
next := currSolId;
curr := pqe^.prev;
number := 0;
while curr <> 0 do
begin
inc (number);
GetQueueElement(curr, pqe);
prev := pqe^.prev;
pqe^.prev := next;
next := curr;
curr := prev;
end;
WriteLn(fout, number);
GetQueueElement(1, pqe);
curr:=pqe^.prev;
for i:=1 to number do
begin
GetQueueElement(curr, pqe);
WriteLn(fout, pqe^.pos.row, ' ', pqe^.pos.column);
curr := pqe^.prev;
end;
end;
Close(fout);
DynDispose;
end;
begin
Init;
Run;
Done;
end.