Форум Всеукраїнської інтернет-олімпіади NetOI
На форумі обговорюються лише питання, пов'язані з олімпіадою
Ви не зайшли.
#1 2008-10-18 13:24:44
- Брэнд
- Новий користувач
- Звідки: Днепропетровск
- Зареєстрований: 2007-09-30
- Повідомлень: 44
Разбор задач второго тура
"Книжная полка".
Очевидно, что как бы мы не ложили книги, всегда можно задать нумерацию по признаку "слева направо; если одинаково, то сверху вниз". То есть, при любом расположении книг, будет существовать М! перестановок.
Далее будем предполагать, что книги, которые лежат на боку, представляют собой "сборник". Будем рассматривать его как единый элимент. Так, если сборников будет К, то комбинаций их расположений будет С(K, M-К*(N-1)). Отсюда К находится в пределах 0..[M/N]. Сумма чисел комбинаций для всех целых К из этого отрезка будет количеством всевозможных положений книг.
Полученые два числа мы перемножаем и получаем ответ: М!*Е(С(K, M-К*(N-1))) для всех целых 0<=К<=[M/N].
Особенность: использование длинной арифметики.
"Жабы".
Ничего особого не придумал. По сути, поиск в ширину, но быстро работает и простой поиск многократным проходом по доске [0..100, 0..100].
Код:
var x2,y2,x1,y1,k,w,i,j:integer;
a:array[-100..200,-100..200]of integer;
b,c:array[0..10200]of integer;
procedure q(x,y:integer);
begin if a[x,y]<0then a[x,y]:=k;end;
begin
fillchar(a,sizeof(a),255);
read(x1,y1,x2,y2);
a[x1,y1]:=0;k:=0;w:=-1;
while a[x2,y2]<0do
begin
inc(k);inc(w);
for i:=0to 100do
for j:=0to 100do
if a[i,j]=w then
begin
q(i-1,2*i-j);
q(i+1,2*i-j);
q(2*j-i,j-1);
q(2*j-i,j+1);
q(i-1,2*i-j-2);
q(i+1,2*i+2-j);
q(2*j-2-i,j-1);
q(2*j+2-i,j+1);
end;
end;
for i:=-100to -1do fillchar(a[i],sizeof(a[i]),-1);
for i:=101to 200do fillchar(a[i],sizeof(a[i]),-1);
for i:=0to 100do
begin
for j:=-100to -1do a[i,j]:=-1;
for j:=101to 200do a[i,j]:=-1;
end;
k:=a[x2,y2];
w:=k;
while k>-1 do
begin
b[k]:=x2;c[k]:=y2;dec(k);
if a[x2+1,2*x2-y2]=k then begin y2:=2*x2-y2; inc(x2);end else
if a[x2-1,2*x2-y2]=k then begin y2:=2*x2-y2; dec(x2);end else
if a[2*y2-x2,y2+1]=k then begin x2:=2*y2-x2; inc(y2);end else
if a[2*y2-x2,y2-1]=k then begin x2:=2*y2-x2; dec(y2);end else
if a[x2+1,2*x2+2-y2]=k then begin y2:=2*x2+2-y2;inc(x2);end else
if a[x2-1,2*x2-2-y2]=k then begin y2:=2*x2-2-y2;dec(x2);end else
if a[2*y2+2-x2,y2+1]=k then begin x2:=2*y2+2-x2;inc(y2);end else
begin x2:=2*y2-2-x2;dec(y2);end;
end;
writeln(w+1);
for k:=0to w do writeln(b[k],' ',c[k]);
end.Поза форумом
#2 2008-10-18 13:49:14
- Брэнд
- Новий користувач
- Звідки: Днепропетровск
- Зареєстрований: 2007-09-30
- Повідомлень: 44
Re: Разбор задач второго тура
"Разные цифры".
Вычисляем количество цифр в нужном числе, каким по счету является наименьшее из чисел такой же длины и каким после него является нужное число. Далее делаем простой перебор чисел.
Код:
const z:array[1..11]of longint=(1,10,91,739,5275,32491,168571,712891,2345851,5611771,8877691);
var m,n:longint;
c,i,k:shortint;
q:boolean;
a:array[1..10]of byte;
b:array[-1..10]of boolean;
begin
read(m);n:=10;
fillchar(b,sizeof(b),false);
while m<z[n]do dec(n);
if m*2<z[n]+z[n+1] then {!!!!!!!!!}
....
begin
m:=m-z[n];
a[n]:=1; b[1]:=true;
a[n-1]:=0; b[0]:=true;
for i:=n-2downto 1do
begin
a[i]:=n-i;b[n-i]:=true;
end;
while m>0do
begin
k:=1;
q:=false;
repeat
c:=a[k]+1;
while b[c]do inc(c);
if c=10then
begin
b[a[k]]:=false;
inc(k);
end
else
begin
b[a[k]]:=false;
b[c]:=true;
a[k]:=c;
c:=0;
for i:=k-1downto 1do
begin
while b[c]do inc(c);
a[i]:=c;
b[c]:=true;
inc(c);
end;
q:=true;
end;
until q;
dec(m);
end;
for i:=n downto 1do write(a[i]);
end;
...При N=1 ответом будет вводимое число. При N=10 делаем то же самое, что и при N=9, а последняя цифра равна разности 45 и суммы остальных чисел.
Особенность: при таком подходе не проходят по времени два теста. Посему делается проверка {!!!!!!!!!}, чтобы определить к какому из чисел (1023... или 9876...) нужное число ближе. Код написан для близости к 1023... . Для более эффективной работы пишется аналогичный дополнительный кусок перебора от 9876...
Поза форумом
#3 2008-10-18 14:40:48
- redman17
- Новий користувач
- Звідки: Винница
- Зареєстрований: 2008-09-04
- Повідомлень: 82
Re: Разбор задач второго тура
"Разные цифры":
Определив длину числа не обязательно осуществлять полный перебор (потому и таймлимит). Зная кол-во чисел с разными цифрами и длиной на один меньше определяется отдельно каждая цифра искомого числа:
Код:
program diferentdigits;
type sof=set of 0..9;
var i,n,l,j,q,s:longint;
r:sof;
function size(r:sof):longint;
var s:longint;
i:0..9;
begin
s:=0;
for i:=0 to 9 do
if (i in r) then s:=s+1;
size:=s;
end;
function cnt_lng(l:longint;r:sof):longint;
var i,j,s:longint;
begin
if l<=0 then begin cnt_lng:=1; exit; end;
i:=2;
s:=size(r-[0]);
j:=size(r)-1;
while (i<=l) and (j>0) do
begin
i:=i+1;
s:=s*j;
j:=j-1;
end;
cnt_lng:=s;
end;
function cnt_lng0(l:longint;r:sof):longint;
var i,j,s:longint;
begin
if l<=0 then begin cnt_lng0:=1; exit; end;
i:=2;
s:=size(r);
j:=size(r)-1;
while (i<=l) and (j>0) do
begin
i:=i+1;
s:=s*j;
j:=j-1;
end;
cnt_lng0:=s;
end;
begin
read(n);
l:=0;
s:=0;
while s<n do begin l:=l+1; s:=s+cnt_lng(l,[0..9]); end;
s:=s-cnt_lng(l,[0..9]);
r:=[0..9];
n:=n-s;
for i:=1 to l do
begin
j:=0;
if i=1 then j:=1;
while not (j in r) do j:=j+1;
q:=cnt_lng0(l-i,r-[j]);
while n>q do
begin
repeat j:=j+1; until j in r;
n:=n-cnt_lng0(l-i,r-[j]);
end;
write(j);
r:=r-[j];
end;
writeln;
end.WE DIE HARD!!!
Поза форумом
#4 2008-10-18 14:53:20
- redman17
- Новий користувач
- Звідки: Винница
- Зареєстрований: 2008-09-04
- Повідомлень: 82
Re: Разбор задач второго тура
"Книжная полка"
Еще один вариант: пусть все книги одинаковы. Тогда на каждом конкретном шагу мы можем положить либо одну книгу вертикально либо N горизонтально - а это уже рекурентное соотношение f(i)=f(i-1)+f(i-n). Ответом к задаче будет M!*f(M)
Код:
program bookshelf;
const ml=500;
type bn=array [0..ml] of byte;
var v,u:bn;
m,n,i:longint;
s:array[0..100] of bn;
function sign(x:longint):shortint;
begin
if x=0 then sign:=0
else if x>0 then sign:=1
else sign:=-1;
end;
function max(a,b:longint):longint;
begin
if a>b then max:=a else max:=b;
end;
procedure writebn(a:bn);
var i:word;
begin
for i:=a[0] downto 1 do write(a[i]);
end;
procedure setbn(var a:bn; x:longint);
var i,p:longint;
begin
fillchar(a,sizeof(a),0);
p:=x;
i:=1;
repeat
a[i]:=p mod 10;
p:=p div 10;
i:=i+1;
until p=0;
a[0]:=i-1;
end;
procedure sumbn(a,b:bn; var c:bn);
var i,p:word;
begin
setbn(c,0);
i:=1;
p:=0;
while ((i<=a[0]) or (i<=b[0])) or (p<>0) do
begin
c[i]:=(a[i]+b[i]+p) mod 10;
p:=(a[i]+b[i]+p) div 10;
i:=i+1;
end;
c[0]:=i-1;
end;
function mlbn(a,b:bn):shortint;
var i:word;
q:shortint;
begin
q:=sign(a[0]-b[0]);
i:=max(a[0],b[0]);
while (q=0) and (i>=1) do
begin
q:=sign(a[i]-b[i]);
i:=i-1;
end;
mlbn:=q;
end;
procedure mulln(a:bn; k:longint; var b:bn);
var i,p:word;
begin
setbn(b,0);
i:=1;
p:=0;
while (i<=a[0]) or (p<>0) do
begin
b[i]:=(a[i]*k+p) mod 10;
p:=(a[i]*k+p) div 10;
i:=i+1;
end;
b[0]:=i-1;
end;
function findlng(a:bn):word;
var i:word;
begin
i:=ml;
while a[i]=0 do i:=i-1;
findlng:=max(i,1);
end;
procedure mulbn(a,b:bn; var c:bn);
var i,j,p:word;
q,z:bn;
begin
setbn(q,0);
for i:=1 to a[0] do
begin
setbn(z,0);
mulln(b,a[i],z);
for j:=z[0] downto 1 do z[j+i-1]:=z[j];
for j:=i-1 downto 1 do z[j]:=0;
z[0]:=z[0]+i-1;
sumbn(z,q,q);
end;
c:=q;
c[0]:=findlng(c);
end;
procedure fact(n:longint; var f:bn);
var i:longint;
begin
setbn(f,1);
for i:=2 to n do mulln(f,i,f);
end;
begin
readln(m,n);
setbn(s[0],1);
for i:=1 to m do
if i<n then s[i]:=s[i-1] else sumbn(s[i-1],s[i-n],s[i]);
fact(m,v);
mulbn(v,s[i],u);
writebn(u);
end.WE DIE HARD!!!
Поза форумом
#5 2008-10-18 15:30:14
- redman17
- Новий користувач
- Звідки: Винница
- Зареєстрований: 2008-09-04
- Повідомлень: 82
Re: Разбор задач второго тура
Subway
Два основных момента задачи:
- ответом будет минимум из всех расстояний между всеми точками первого (второго) многоугольника и отрезками второго (первого)
- собственно нахождение расстояния между точкой и отрезком (s):
формула для нахождения расстояния между точкой и прямой (d) в принципе известна: d=(a*x0+b*y0+c)/sqrt(a*a+b*b)
(a,b,c - параметры прямой; x0,y0 - координаты точки). Это расстояние - длина перпендикуляра опущеного с даной точки на даную прямую. Но он то может и не попасть на отрезок. Поэтому найдем расстояние от даной точки до начала (d1), середины (d2) и конца (d3) даного отрезка. Если d1<d2<d3 то перпендикуляр попадет в точку "перед" началом отрезка искомое s=d1; если d1>d2>d3 то перпендикуляр попадет в точку "за" концом отрезка искомое s=d3; если же d1>=d2<=d3, то наш перпендикуляр "попадает" в отрезок и s=d
Код:
{$Q-,R-,S-}
program subway;
type pnt=record
x,y:real;
end;
line=record
a,b,c:real;
p1,p2:pnt;
end;
plnm=record
n:integer;
a:array[1..100] of pnt;
end;
var p1,p2:plnm;
i,j,k:longint;
l:line;
ans,nans:real;
ps,pf,aps,apf:pnt;
procedure points2line(p1,p2:pnt; var l:line);
var q:real;
begin
l.p1:=p1;
l.p2:=p2;
l.a:=p2.y-p1.y;
l.b:=p1.x-p2.x;
l.c:=-p1.y*l.b-p1.x*l.a;
q:=sqrt(sqr(l.a)+sqr(l.b));
l.a:=l.a/q;
l.b:=l.b/q;
l.c:=l.c/q;
end;
function dst(p1,p2:pnt):real;
begin
dst:=sqrt(abs(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)));
end;
procedure line_line(l1,l2:line;var p:pnt);
begin
p.x:=(l1.b*l2.c-l1.c*l2.b)/(l1.a*l2.b-l1.b*l2.a);
p.y:=(l1.a*l2.c-l1.c*l2.a)/(l1.b*l2.a-l1.a*l2.b);
end;
function dst_pntline(p:pnt;l:line;var ps,pf:pnt):real;
var d1,d2,d,ds:real;
s:pnt;
lp:line;
begin
d1:=dst(p,l.p1);
d2:=dst(p,l.p2);
s.x:=(l.p1.x+l.p2.x)/2;
s.y:=(l.p1.y+l.p2.y)/2;
ds:=dst(p,s);
d:=abs(l.a*p.x+l.b*p.y+l.c);
ps:=p;
if (d1>=ds) and (ds<=d2) then
begin
dst_pntline:=d;
lp.a:=-l.b;
lp.b:=l.a;
lp.c:=-p.y*lp.b-p.x*lp.a;
line_line(l,lp,pf);
end;
if (d1<ds) and (ds<d2) then
begin
dst_pntline:=d1;
pf:=l.p1;
end;
if (d1>ds) and (ds>d2) then
begin
dst_pntline:=d2;
pf:=l.p2;
end;
end;
begin
readln(p1.n);
for i:=1 to p1.n do read(p1.a[i].x,p1.a[i].y);
readln(p2.n);
for i:=1 to p2.n do read(p2.a[i].x,p2.a[i].y);
ans:=MaxLongint;
for i:=1 to p1.n do
for j:=1 to p2.n do
for k:=j+1 to p2.n do
begin
points2line(p2.a[j],p2.a[k],l);
nans:=dst_pntline(p1.a[i],l,ps,pf);
if nans<ans then
begin
ans:=nans;
aps:=ps;
apf:=pf;
end;
end;
for i:=1 to p2.n do
for j:=1 to p1.n do
for k:=j+1 to p1.n do
begin
points2line(p1.a[j],p1.a[k],l);
nans:=dst_pntline(p2.a[i],l,ps,pf);
if nans<ans then
begin
ans:=nans;
aps:=ps;
apf:=pf;
end;
end;
writeln(aps.x:3:3,' ',aps.y:3:3);
writeln(apf.x:3:3,' ',apf.y:3:3);
end.Відредаговано redman17 (2008-10-18 15:31:40)
WE DIE HARD!!!
Поза форумом
#6 2008-10-18 15:34:53
- redman17
- Новий користувач
- Звідки: Винница
- Зареєстрований: 2008-09-04
- Повідомлень: 82
Re: Разбор задач второго тура
Frogs
действительно самый простой вариант - поиск в ширину:
Код:
{$B-,Q-,R-,S-}
program frogs;
const max_dp=101*101+1;
type longint=0..max_dp;
var a0,b0,a,b,x,y,u,i,a1,b1:longint;
r:array[0..100,0..100] of boolean;
h,t:longint;
dp:array[1..max_dp,1..3] of longint;
p:array[1..max_dp,1..2] of longint;
procedure put(x,y:longint);
begin
if (x>=0) and (x<=100) and (y>=0) and (y<=100) and (not r[x,y]) then
begin
dp[t,1]:=x;
dp[t,2]:=y;
dp[t,3]:=h;
t:=t+1;
r[x,y]:=true;
end;
end;
begin
read(a0,b0,a,b);
h:=1;
t:=2;
dp[1,1]:=a0;
dp[1,2]:=b0;
dp[1,3]:=0;
r[a0,b0]:=true;
while not r[a,b] do
begin
a1:=dp[h,1];
b1:=dp[h,2];
x:=2*b1-a1; y:=b1+1; put(x,y);
y:=b1+1; x:=2*y-a1; put(x,y);
x:=2*b1-a1; y:=b1-1; put(x,y);
y:=b1-1; x:=2*y-a1; put(x,y);
y:=2*a1-b1; x:=a1+1; put(x,y);
x:=a1+1; y:=2*x-b1; put(x,y);
y:=2*a1-b1; x:=a1-1; put(x,y);
x:=a1-1; y:=2*x-b1; put(x,y);
h:=h+1;
end;
u:=t+1;
while (dp[u,1]<>a) or (dp[u,2]<>b) do u:=u-1;
y:=1;
p[1,1]:=a;
p[1,2]:=b;
u:=dp[u,3];
while u<>0 do
begin
y:=y+1;
p[y,1]:=dp[u,1];
p[y,2]:=dp[u,2];
u:=dp[u,3];
end;
writeln(y);
for i:=y downto 1 do writeln(p[i,1],' ',p[i,2]);
end.WE DIE HARD!!!
Поза форумом