Абракадабра

В

a	a	b	r	a	k
a	b	r	a	k	a
a	k	a	a	b	r
b	r	a	k	a	a
k	a	a	b	r	a
r	a	k	a	a	b

о время своей работы алгоритм сжатия данныхметодом «сортировки блока» применяет к блокам данных преобразование, которое определяется следующим образом.

Строка P называется ротацией строки S, если она образована циклическим сдвигом символов S, т.е. если S=a₁a₂…a_N, где a_i — i–ый символ строки S, то P=a_pa_p+1…a_Na₁…a_p-1, где 1pN. Рассмотрим таблицу M размера NN, строками которой есть все ротации строки S, отсортированные в лексикографическом (словарном) порядке по возрастанию.

Пусть строка L есть последний столбик таблицы M. Прямое преобразование получает на вход строку S, выдает строку L и число K — номер строки таблицы M, который содержит строку S. (Если таких строк несколько, выдается номер любой из них).

Для S='abraka' таблица M изображена на рисунке. Строка S находится во второй строке таблицы M, L=‘karaab’.

Задание

Напишите программу ABRAKA, которая выполняет обратное преобразование, т.е. получает на вход строку L и число K, и выдает строку S.

Входные данные

Первая строка входного файла ABRAKA.DAT содержит два целых числа: K и N, 1N30000, 1KN. Вторая строка содержит N символов строки L — маленьких латинских букв.

Выходные данные

Единственная строка выходного файла ABRAKA.SOL должна содержать строку S.

Пример входных и выходных данных

ABRAKA.DAT	ABRAKA.SOL
2 6 karaab	abraka

{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+}

{$M 16384,0,655360}

program Abraka;

type

tArray = array [0..29999] of char;

tIntArray = array [0..29999] of integer;

var

fr, fw: text;

k, n: integer;

l: tArray;

s: ^tArray;

p: ^tIntArray;

c: array ['a'..'z'] of integer;

{ c: array [char] of integer;}

procedure Main;

var

i, j, sum: integer;

ch: char;

begin

{let's fill array c with zeroes}

FillChar(c, sizeof(c), 0);

for i:=0 to n-1 do

begin

p^[i] := c[l[i]];

inc(c[l[i]]);

end;

{now c[ch] is a number of chars ch in the string l;

p[i] - is a number of chars l[i] in the string l[0..i-1]}

sum := 0;

for ch:='a' to 'z' do

begin

sum := sum + c[ch];

c[ch] := sum - c[ch];

end;

{now c[ch] is a number of chars, that are less then ch, in the string l}

i := k - 1;

for j:=n-1 downto 0 do

begin

s^[j] := l[i];

i := p^[i] + c[l[i]];

end;

end;

var

i:integer;

begin

GetMem(s, 30000);

GetMem(p, 60000);

assign(fr, 'abraka.dat');

reset(fr);

assign(fw, 'abraka.sol');

rewrite(fw);

readln(fr, k, n);

for i:=0 to n-1 do

read(fr, l[i]);

Main;

for i:=0 to n-1 do

write(fw, s^[i]);

writeln(fw);

close(fw);

close(fr);

FreeMem(p, 60000);

FreeMem(s, 30000);

end.

Циферблат

На циферблате записана последовательность чисел в двоичной системе счисления. Линии разбиения могут проходить как между числами, так и между цифрами одного числа, разбивая его на два или больше чисел. Для каждого сектора можно посчитать сумму чисел, которые в нем расположены.

Каждое число в последовательности не равно 0, и его запись начинается с единицы. Количество цифр в двоичной записи числа не превышает 25. Общее количество цифр на циферблате не больше чем 100.

Циферблат может быть разбит на сектора. На рисунке изображен привычный нам циферблат с числами от 1 до 12 (в немного непривычном виде). Он разбит на 4 сектора. Суммы в секторах будут 1, 15, 18 и 36.

Задание

Напишите программу DIAL, которая по заданной последовательности определяет количество разных разбиений циферблата на сектора, таких что сумма чисел во всех секторах одинакова.

Входные данные

В единственной строке входного файла DIAL.DAT задана последовательность чисел. Числа последовательности разделены пробелом.

Выходные данные

В единственной строке выходного файла DIAL.SOL должно находиться натуральное число — количество искомых разбиений циферблата на сектора.

Пример входных и выходных данных

DIAL.DAT	DIAL.SOL
101 1 1101	9

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}

{$M 16384,0,655360}

program dial;

const

FileIn = 'dial.dat';

FileOut = 'dial.sol';

MaxN = 100;

var

N : integer;

Num : array[1..MaxN] of integer;

IsStart : array[1..MaxN] of boolean;

Sum : array[1..MaxN, 1..MaxN] of longint;

Answer : longint;

function GetNextNumber(var Buffer, Next : string) : boolean;

begin

GetNextNumber:=false;

Next:='';

while (Length(Buffer)>0)and(Not (Buffer[1] in ['0','1'])) do

Delete(Buffer,1,1);

if Length(Buffer)=0 then exit;

while (Length(Buffer)>0)and(Buffer[1] in ['0','1']) do

begin

Next:=Next+Buffer[1];

Delete(Buffer,1,1);

end;

GetNextNumber:=true;

end;

function GetIndex(Current, Distance : integer) : integer;

var

Index : integer;

begin

Index := (Current+Distance) mod N;

if Index=0 then Index:=N;

GetIndex:= Index;

end;

procedure CountSum;

var

i, j, Ind : integer;

Prev : Longint;

Curr : Longint;

begin

for i:=1 to N do

begin

Prev := 0;

Curr := 0;

for j:=0 to N-1 do

begin

Ind := GetIndex(i,j);

if IsStart[Ind] then

begin

Prev:=Prev+Curr;

Curr:=Num[Ind];

end else

begin

Curr:=Curr*2+Num[Ind];

end;

Sum[i, Ind]:=Prev+Curr;

end;

end;

{test}

{ WriteLn('-----------------------------------------');

for i:=1 to n do

begin

for j:=1 to n do

Write(Sum[i,j]:3, ' ');

WriteLn;

end;}

end;

procedure Init;

var

Fi : Text;

Buffer, Next : string;

begin

FillChar(IsStart, SizeOf(IsStart), false);

FillChar(Num, SizeOf(Num), 0);

FillChar(Sum, SizeOf(Sum), 0);

Answer:=0;

Assign(Fi, FileIn);

Reset(Fi);

ReadLn(Fi, Buffer);

Close(Fi);

N:=0;

while GetNextNumber(Buffer, Next) do

begin

IsStart[N+1]:=true;

while Length(Next)>0 do

begin

Inc(N);

if Next[1]='0' then Num[N]:=0 else Num[N]:=1;

Delete(Next, 1, 1);

end;

end;

CountSum;

end;

function Up(x : integer) : integer;

begin

if x=1 then Up:=n else Up:=x-1;

end;

function Next(x : integer) : integer;

begin

if x=n then Next:=1 else Next:=x+1;

end;

function Previous(x : integer) : integer;

begin

if x=1 then Previous:=n else Previous:=x-1;

end;

var test1, test2 : integer;

function LookForSum(S, F : integer; NeedSum : longint) : boolean;

var i,j : integer;

begin

test1:=s;

test2:=f;

LookForSum := false;

i:=S;

while i<=F do

begin

j:=i;

while (j<=F)and(Sum[i,j]<>NeedSum) do

Inc(j);

if (j>F)or(Sum[i,j]>NeedSum) then

break

else

i:=j+1;

end;

if i=F+1 then

LookForSum := true;

end;

procedure Run;

var

i, j, u, step : integer;

SearchSum : longint;

begin

for i:=n downto 1 do

for j:=1 to Previous(i) do

if LookForSum(j+1, Previous(i), Sum[i,j]) then

begin

(* WriteLn(i, ' ', j, ' ', Sum[i,j]); {Test}*)

Inc(Answer);

end;

end;

procedure Done;

var

Fo : Text;

begin

Assign(Fo, FileOut);

Rewrite(Fo);

WriteLn(Fo, Answer);

Close(Fo);

end;

begin

Init;

Run;

Done;

end.

Кубики

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

Задание

Напишите программу CUBES, которая получает на вход фронтальную и правую проекции фигуры и определяет минимальное и максимальное количество кубиков, которое можно было бы использовать для построения фигуры с заданными проекциями.

Входные данные

В первой строке входного файла CUBES.DAT находятся три числа N, M и К, которые задают размеры проекций (1≤N, M, K≤100). Дальше задаются две проекции: сначала фронтальная, а затем правая. Проекция задается N строками, каждая из которых состоит из чисел 0 и 1, разделенных пробелами. Для фронтальной проекции таких чисел будет M, а для правой — K. 0 означает свободную клетку проекции, 1 — заполненную.

Выходные данные

В единственной строке выходного файла CUBES.SOL должно находиться два числа: минимальное и максимальное число кубиков, которые можно было бы использовать для построения фигуры с заданными проекциями.

Пример входных и выходных данных

CUBES.DAT	CUBES.SOL
2 2 3 1 0 1 1 0 0 1 1 1 1	4 7

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}

{$M 16384,0,655360}

const

FileIn = 'cubes.dat';

FileOut = 'cubes.sol';

MaxN = 100;

type

TProection = array[1..MaxN] of integer;

var

n,m,k : integer;

F, R : TProection;

Possible : boolean;

AnswerMin : longint;

AnswerMax : longint;

function Max(a, b : integer) : integer;

begin

if a>b then Max:=a else Max:=b;

end;

procedure GetProection(var F : Text; var P : TProection; n, m : integer);

var

i, j : integer;

x : integer;

begin

FillChar(P, SizeOf(P), 0);

for i:=1 to n do

for j:=1 to m do

begin

Read(F, x);

P[i]:=P[i]+x;

end;

end;

procedure Init;

var

Fi : Text;

begin

AnswerMin:=0;

AnswerMax:=0;

Assign(Fi, FileIn);

Reset(Fi);

ReadLn(Fi, n, m, k);

GetProection(Fi, F, n, m);

GetProection(Fi, R, n, k);

Close(Fi);

Possible := true;

end;

procedure Run;

var

i : integer;

begin

for i:=1 to n do

begin

if ((F[i]=0)and(R[i]<>0)) or ((F[i]<>0)and(R[i]=0)) then

begin

Possible:=false;

exit;

end;

AnswerMin:=AnswerMin + max(F[i], R[i]);

AnswerMax:=AnswerMax + F[i] * R[i];

end;

end;

procedure Done;

var

Fo : Text;

begin

Assign(Fo, FileOut);

Rewrite(Fo);

if Possible then

WriteLn(Fo, AnswerMin, ' ', AnswerMax)

else

WriteLn(Fo, '0 0');

Close(Fo);

end;

begin

Init;

Run;

Done;

end.