Новости

В городе введено движение автобусов. Все автобусы имеют циклические маршруты. Некоторые маршруты имеют общие остановки. Когда два или больше автобусов встречаются на одной остановке, водители обмениваются всеми новостями, которые им известны на данный момент (после того как они отъедут от остановки, все будут знать одинаковые новости).

Водители начинают движение своих автобусов одновременно, и в это время каждый из водителей знает одну новость, которую не знает ни один из других.

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

Существует D водителей (и, соответственно, D автобусов), которые пронумерованы от 1 до D, и S остановок, которые имеют номера от 1 до S.

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

Входные данные Входной текстовый файл BUS.DAT в первой строке содержит число тестов N. Далее следует N блоков информации, каждый из которых соответствует одному тесту. Первая строка блока содержит два целых числа D (1D100) и S (1S250). Каждая из следующих D строк описывает маршрут одного из автобусов таким образом: первое число — количество остановок на данном маршруте M_i, после чего M_i разных целых чисел, которые задают последовательность остановок маршрута. Движение автобуса начинается с остановки, которая указана первой.

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

2

1 3

3 1 2 3

2 2

2 1 2

2 2 1

Выходные данные Каждая строка текстового файла BUS.SOL должна содержать ответ для одного теста. Необходимо вывести 1, если каждый водитель узнает все новости, или 0 в противном случае.

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

1

0

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

{$M 16384,0,655360}

const

FileIn = 'bus.dat'; {Input file}

FileOut = 'bus.sol'; {Output file}

MaxD = 100; {Maximal bus lines}

MaxS = 250; {Maximal bus stops}

type

TNodS = array[1..MaxS, 1..MaxS] of byte;

var

ManyTest, Test : integer; {Vars to work with many testes}

Fi,Fo : Text; {Text files}

S, D : integer;

Nods : ^TNodS;

Z : array[1..MaxD, 1..MaxS] of byte; {Matrics of meeting}

A : array[1..MaxD, 1..MaxD] of byte; {Matrics of smezhnost'}

B : array[1..MaxD] of boolean; {Search at depth}

ManyB : integer; {Many truth in B}

L : array[1..MaxD, 1..MaxS] of byte; {List of lines}

Many : array[1..MaxD] of integer; {Many of stops in lines}

procedure Swap(var a,b : integer);

var

c: integer;

begin

c:=a;a:=b;b:=c;

end;

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

begin

if a<b then Swap(a,b);

a:=a mod b;

if a<b then Swap(a,b);

if B=0 then Nod:=a else Nod:=Nods^[b,a];

end;

procedure GetNod;

var

i,j : integer;

begin

New(NodS);

FillChar(Nods^,sizeof(Nods^),0);

for i:=1 to MaxS do

for j:=i to MaxS do

begin

Nods^[i,j]:=nod(i,j);

Nods^[j,i]:=Nods^[i,j];

end;

end;

procedure Init;

var

i,j : integer;

begin

FillChar(Z, SizeOf(Z), 0);

ReadLn(Fi, D, S);

for i:=1 to d do

begin

Read(Fi, Many[i]);

for j:=1 to Many[i] do

begin

Read(Fi, L[i,j]);

Z[i,L[i,j]]:=j;

end;

end;

FillChar(A, SizeOf(A), 0);

FillChar(B, SizeOf(B), false);

ManyB:=0;

end;

function Check(y,x : integer) : boolean;

var

i,CurrNod, ShiftX, ShiftY : integer;

Answer : boolean;

begin

if Many[x]<Many[y] then Swap(X,Y);

Answer:=false; i:=1;

while (i<=many[y])and(not Answer) do

begin

if Z[x,L[y,i]]<>0 then

begin

CurrNod := Nods^[Many[y], Many[x]];

ShiftY:=Many[y]-i; if ShiftY<=0 then ShiftY:=ShiftY+Many[y];

ShiftX:=Many[x]-Z[x,L[y,i]]; if ShiftX<=0 then ShiftX:=ShiftX+Many[x];

if Abs(ShiftY-ShiftX) mod CurrNod = 0 then Answer:=true;

end;

Inc(I);

end;

Check:=Answer;

end;

procedure Search(Start : integer);

var

i : integer;

begin

if B[Start] then exit;

B[Start]:=true;

Inc(ManyB);

for i:=1 to d do

if not B[i] then

begin

if A[Start,i]=0 then

begin

if Check(Start,i) then A[Start,i]:=1 else A[Start,i]:=2;

A[i, Start]:=A[Start,i];

end;

if A[Start, i]=1 then Search(i);

end;

end;

procedure Run;

begin

Search(1);

end;

procedure Done;

begin

if ManyB=d then WriteLn(Fo, 1) else Writeln(Fo, 0);

end;

begin

GetNod;

Assign(Fi, FileIN); Reset(Fi);

Assign(Fo, FileOut); Rewrite(Fo);

ReadLn(Fi, ManyTest);

for Test:=1 to ManyTest do

begin

Init;

Run;

Done;

end;

Close(Fi);

Close(Fo);

Dispose(Nods);

end.

Лото

Достаточно популярной есть лотерея, которая проводится по таким правилам: из набора N шариков случайно выбираются K шариков, которые являются выигрышными. Выигрывают игроки, которые предвидели выбор именно этих шариков. Нетрудно подсчитать количество C вариантов выбора K шариков из набора N шариков.

Задание Написать программу LOTO которая определит, какое именно количество шариков необходимо брать из набора N шариков, если количество вариантов выбора есть C.

Входные данные Входной текстовый файл LOTO.DAT содержит в единственной строке два числа — N и C (1N500000).

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

15 5005

Выходные данные Единственная строка текстового файла LOTO.SOL должна содержать число K — количество шариков, которые надо брать.

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

6

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

{$M 16384,0,655360}

program loto;

function lg(i: Extended): Extended;

begin lg := ln(i)/ln(10) end;

function lgCnk(n, k: LongInt): Extended;

var

I: LongInt;

R: Extended;

begin

R := 0;

for i := n - k + 1 to n do R := R + lg(i);

for i := 1 to k do R := R - lg(i);

lgCnk := R;

end;

function lgnk(n,k:LongInt):Extended;

begin

lgnk := lg(n)*(n+1/2)-lg(k)*(k+1/2)-lg(n-k)*(n-k+1/2)-lg(2*pi)/2;

end;

var

l,r,t:LongInt;

{ o:extended;}

var

Inp: file of Char;

Out: Text;

N: LongInt;

S: Char;

C, P, LC: Extended;

I: Integer;

begin

Assign(Inp, 'LOTO.DAT');

Reset(Inp);

Assign(Out, 'LOTO.SOL');

Rewrite(Out);

N := 0;

Read(Inp, S);

repeat

N := N * 10 + (Byte(S)-Byte('0'));

Read(Inp, S);

until S = ' ';

I := 0; P := 1;

Read(Inp, S);

while not (S = #13) and (I < 18) do

begin

C := C + (Byte(S)-Byte('0'))*P;

P := P / 10;

I := I + 1;

Read(Inp, S);

end;

LC := lg(C) + I - 1;

while S <> #13 do

begin

LC := LC + 1;

Read(Inp, S);

end;

{ Writeln('LC=',LC:1:20);}

l := 1;

r := n div 2;

while l <> r do

begin

t := (l + r) div 2;

{ Writeln('(',l,',',r,')',t, ' : ', lgnk(n, t):1:20);}

if lgnk(n, t) < LC then l := t + 1 else r := t;

end;

Writeln(Out, l);

Close(Out);

Close(Inp);

end.

Парк

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

Задание Написать программу PARK, которая будет находить одно из возможных расположений деревьев в парке.

Входные данные Входной текстовый файл PARK.DAT в первой строке содержит количество тестов. Каждая следующая строка содержит одно целое число N – количество видов (цветов) деревьев, которые необходимо посадить в парке (3N100).

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

2

3

4

Выходные данные Выходной текстовый файл PARK.SOL должен содержать ответы для всех тестов из входного файла в том же порядке. Для каждого теста нужно выдать либо единственную строку с числом 0, если расположение невозможно, или N строк, первая из которых содержит одно число, вторая — два числа, N–я — N чисел — номеров цветов деревьев в расположении. Цвета нумеруются натуральными числами от 1 до N.

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

2

3 1

1 2 3

0

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

{$M 16384,0,655360}

program Park;

const

NMax = 100;

var

A: array[0..NMax, 0..NMax] of Byte;

B: array[1..3, 0..NMax] of set of Byte;

Dat, Sol: Text;

K, N, t, i, j, c: Integer;

begin

Assign(Dat, 'park.dat');

Reset(Dat);

Assign(Sol, 'park.sol');

Rewrite(Sol);

Read(Dat, K);

for t := 1 to K do

begin

Read(Dat, N);

{Writeln(N);}

Dec(N);

if not odd(N)

then begin

for i := 0 to N do

begin

for j := 0 to i do

if N - i - j < 0

then Write(Sol, N - i - j + 1 + N + 1, ' ')

else Write(Sol, N - i - j + 1, ' ');

Writeln(Sol);

end;

end

else begin

for i := 0 to N do

begin

A[i, 0] := i + 1;

B[1, i] := [i + 1];

B[2, i] := [];

B[2, 0] := B[2,0] + [i + 1];

B[3, i] := [i + 1];

end;

A[1,1] := 0;

i := 1;

j := 1;

while (i <= N) and (i > 0) do

begin

c := A[i,j];

B[1, i] := B[1, i] - [c];

B[2, j] := B[2, j] - [c];

B[3, i - j] := B[3, i - j] - [c];

repeat

inc(c);

until (c > N + 1) or not ((c in B[1, i]) or (c in B[2, j]) or (c in B[3, i - j]));

if c <= N + 1

then begin

A[i, j] := c;

B[1, i] := B[1, i] + [c];

B[2, j] := B[2, j] + [c];

B[3, i - j] := B[3, i - j] + [c];

inc(j);

if j > i then begin j := 1; inc(i) end;

if i <= N then A[i,j] := 0;

end

else begin

A[i,j] := 0;

dec(j);

if j < 1 then begin j := i - 1; dec(i) end;

end;

{ if i > N

then begin

for i := 0 to N do

begin

for j := 0 to i do Write(Sol, A[i,j], ' ');

Writeln(Sol)

end;

i := N; j := i;

Write('+')

end}

end;

if i > 0

then begin

for i := 0 to N do

begin

for j := 0 to i do Write(Sol, A[i,j], ' ');

Writeln(Sol)

end

end

else Writeln(Sol, 0);

end;

end;

Close(Dat);

Close(Sol);

end.

Пещера

Гном Торин нашел план покинутой пещеры, в которой жил горный король Норус. На плане обозначено место, где находятся огромный клад. Горный король защитил свое богатство от искателей кладов, для чего расположил в пещере L каменных блоков, которые двигаются и могут раздавить искателя, и которые останавливаются, когда сокровища найдены.

План задан в виде прямоугольной целочисленной матрицы MxN, элементами которой могут быть: -2 (клад), -1 (стена), 0 (пустое место), положительное число K (элемент K–го блока). K–й блок состоит из всех элементов, обозначенных числом K. Блок не обязательно связный, но все его элементы движутся синхронно. Нули в крайних строках или столбцах матрицы обозначают входы в пещеру. Отдельно указано начальное направление движения каждого блока (1 – вверх, 2 – направо, 3 – вниз, 4 – влево).

Гном занимает клетку-вход. После этого он движется по таким правилам: на протяжении каждой секунды первым перемещается гном на пустую клетку из 4-х соседних (вверх, вниз, влево или направо) или остается на месте. Потом, на протяжении той же секунды, перемещается каждый блок на одну клетку (вверх, вниз, влево или направо): сначала первый, за ним второй и т.д. Если перед каким-нибудь элементом в направлении его движения находится стена, край пещеры, клад или другой блок, то на этом ходе блок не движется, а направление его движения изменяется на противоположное. Если блок во время движения попал в клетку с гномом, то гном гибнет.

Задание Написать программу CAVE для поиска безопасного пути, который приведет к кладу за наименьшее время, считая, что такой путь существует.

Входные данные Входной текстовый файл CAVE.DAT в первой строке содержит два числа M, N та L—количество блоков (3M75, 3N75, 0L1000). В следующих M строках содержаться N целых чисел — план пещеры. В следующих L строках заданы начальные направления их движения в порядке увеличения номеров.

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

4 5 1

-1 -1 -1 -1 -1

-1 0 1 0 -1

0 0 0 -2 -1

-1 -1 -1 -1 -1

1

Выходные данные Выходной текстовый файл CAVE.SOL в первой строке должен содержать число K — время прохождения пути в секундах. В следующих K+1 строках — координаты положения гнома в каждую секунду (начиная с координат входа). Координаты должны быть заданы в порядке "строка столбец". Если существует несколько путей, достаточно указать один из них.

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

5

3 1

3 2

2 2

2 3

2 4

3 4

program Treasure;

const

num = 75;

type

plist=^tlist;

tlist=record

x,y:byte;

next:plist;

end;

psplist=^tsplist;

tsplist=record

time:integer;

x,y:byte;

next:psplist;

end;

wall=record

direct:byte;

data:plist;

end;

var

fi,fo:text;

m,n,l,i,j:integer;

arr:array [1..num,1..num] of record

data:integer;

list:psplist;

end;

walls:array [1..1000] of wall;

curtime:integer;

procedure add(var list:plist;x,y:byte);

var p:plist;

begin

new(p);

p^.x:=x;p^.y:=y;

p^.next:=list;

list:=p;

end;

procedure addsp(var list:psplist;time:integer;x,y:byte);

var p:psplist;

begin

new(p);

p^.time:=time;p^.x:=x;p^.y:=y;

p^.next:=list;

list:=p;

end;

procedure disposesplist(var list:psplist);

var cur:psplist;

begin

while list<>nil do

begin

cur:=list^.next;

dispose(list);

list:=cur;

end;

end;

procedure disposelist(var list:plist);

var cur:plist;

begin

while list<>nil do

begin

cur:=list^.next;

dispose(list);

list:=cur;

end;

end;

procedure readwalls;

begin

for i:=1 to m do

for j:=1 to n do if arr[i,j].data>0 then

add(walls[arr[i,j].data].data,i,j);

end;

procedure findpath(x,y:byte);

var i,j:byte;

list,cur:plist;

cur1:psplist;

begin

writeln(fo,curtime);

list:=nil;i:=x;j:=y;

add(list,i,j);inc(curtime);

repeat

dec(curtime);

while curtime<arr[i,j].list^.time do

begin

cur1:=arr[i,j].list^.next;dispose(arr[i,j].list);arr[i,j].list:=cur1;

end;

if curtime=arr[i,j].list^.time then

begin

add(list,arr[i,j].list^.x,arr[i,j].list^.y);

x:=arr[i,j].list^.x;y:=arr[i,j].list^.y;

cur1:=arr[i,j].list^.next;dispose(arr[i,j].list);arr[i,j].list:=cur1;

i:=x;j:=y;

end else add(list,i,j);

until curtime=1;

cur:=list;

while cur<>nil do

begin

writeln(fo,cur^.x,' ',cur^.y);

cur:=cur^.next;dispose(list);list:=cur;

end;

for i:=1 to l do disposelist(walls[i].data);

for i:=1 to m do for j:=1 to n do disposesplist(arr[i,j].list);

close(fo);

end;

procedure count;

begin

for i:=1 to m do

for j:=1 to n do

if (arr[i,j].data>=1001) and (arr[i,j].data<curtime+1001) then

begin

if (i<m) and (arr[i+1,j].data=-2) then

begin

addsp(arr[i+1,j].list,curtime,i,j);

findpath(i+1,j);halt;

end;

if (i<m) and (arr[i+1,j].data=0) then

begin

arr[i+1,j].data:=curtime+1001;

addsp(arr[i+1,j].list,curtime,i,j);

end;

if (i>1) and (arr[i-1,j].data=-2) then

begin

addsp(arr[i-1,j].list,curtime,i,j);

findpath(i-1,j);halt;

end;

if (i>1) and (arr[i-1,j].data=0) then

begin

arr[i-1,j].data:=curtime+1001;

addsp(arr[i-1,j].list,curtime,i,j);

end;

if (j<n) and (arr[i,j+1].data=-2) then

begin

addsp(arr[i,j+1].list,curtime,i,j);

findpath(i,j+1);halt;

end;

if (j<n) and (arr[i,j+1].data=0) then

begin

arr[i,j+1].data:=curtime+1001;

addsp(arr[i,j+1].list,curtime,i,j);

end;

if (j>1) and (arr[i,j-1].data=-2) then

begin

addsp(arr[i,j-1].list,curtime,i,j);

findpath(i,j-1);halt;

end;

if (j>1) and (arr[i,j-1].data=0) then

begin

arr[i,j-1].data:=curtime+1001;

addsp(arr[i,j-1].list,curtime,i,j);

end;

end;

end;

function check(x,y,direct:byte):integer;

begin

case direct of

4:if y>1 then check:=arr[x,y-1].data else check:=-100;

2:if y<n then check:=arr[x,y+1].data else check:=-100;

1:if x>1 then check:=arr[x-1,y].data else check:=-100;

3:if x<m then check:=arr[x+1,y].data else check:=-100;

end;

end;

function checkwalls(list:plist; direct:byte):boolean;

var cur:plist;

begin

cur:=list;checkwalls:=false;

while cur<>nil do

begin

if (check(cur^.x,cur^.y,direct)>=1001)

or (check(cur^.x,cur^.y,direct)=0) then cur:=cur^.next

else exit;

end;

checkwalls:=true;

end;

procedure clearwalls(list:plist);

var cur:plist;

begin

cur:=list;

while cur<>nil do

begin

arr[cur^.x,cur^.y].data:=0;

cur:=cur^.next;

end;

end;

procedure changewalls(list:plist;direct:byte);

var cur:plist;

begin

cur:=list;

while cur<>nil do

begin

case direct of

1:dec(cur^.x);

2:inc(cur^.y);

3:inc(cur^.x);

4:dec(cur^.y);

end;

cur:=cur^.next;

end;

end;

procedure drawwalls(list:plist;number:integer);

var cur:plist;

begin

cur:=list;

while cur<>nil do

begin

arr[cur^.x,cur^.y].data:=number;

cur:=cur^.next;

end;

end;

procedure incwalls;

var i,j:integer;

begin

for i:=1 to l do

begin

if not checkwalls(walls[i].data,walls[i].direct) then

begin

case walls[i].direct of

1:walls[i].direct:=3;

2:walls[i].direct:=4;

3:walls[i].direct:=1;

4:walls[i].direct:=2;

end;

end else

begin

clearwalls(walls[i].data);

changewalls(walls[i].data,walls[i].direct);

drawwalls(walls[i].data,i);

end;

end;

end;

begin

assign(fi,'cave.dat');reset(fi);assign(fo,'cave.sol');rewrite(fo);

readln(fi,m,n,l);

for i:=1 to m do

begin

for j:=1 to n do

begin

read(fi,arr[i,j].data);

arr[i,j].list:=nil;

end;

readln(fi);

end;

for i:=1 to l do readln(fi,walls[i].direct);readwalls;

close(fi);

for i:=1 to m do if arr[i,1].data=0 then

begin arr[i,1].data:=1001;addsp(arr[i,1].list,0,0,0);end;

for i:=1 to m do if arr[i,n].data=0 then

begin arr[i,n].data:=1001;addsp(arr[i,n].list,0,0,0);end;

for j:=1 to n do if arr[1,j].data=0 then

begin arr[1,j].data:=1001;addsp(arr[1,j].list,0,0,0);end;

for j:=1 to n do if arr[m,j].data=0 then

begin arr[m,j].data:=1001;addsp(arr[m,j].list,0,0,0);end;

curtime:=0;

repeat

inc(curtime);

count;

incwalls;

until false;

end.