Здесь вы можете увидеть решение некоторых задач с сайта e-olimp.com
Решение задач с сайта e-olimp.com
Страница: 1
Сообщений 1 страница 24 из 24
Поделиться22016-03-22 23:16:29
Задача №2 Цифры
Посчитать количество цифр целого неотрицательного числа N (0 <= N <=2000000000).
var i:integer;
c:char;
begin
i:=0;
repeat
read (c);
if c in ['0'..'9'] then inc (i);
until ord(c)=13;
writeln (i);
end.
Поделиться32016-03-22 23:18:22
Задача №3 Спичечная модель
Профессор Самоделкин решил изготовить объемную модель кубиков из спичек, используя спички для рёбер кубиков. Длина ребра каждого кубика равна одной спичке. Для построения модели трех кубиков он использовал 28 спичек.
Какое наименьшее количество спичек нужно Самоделкину для построения модели из N кубиков?
var a:array[1..900, 1..900, 1..900] of integer;
l, p, n, k, s, i, j, m, rez, count:longint;
flag:boolean;
begin
readln (n);
k:=1;s:=1;
while s<n do
begin
inc(k);
s:=k*k*k;
end;
{--------- 1 ryad ----------}
a[1,1,1]:=12;
for i:=2 to k do a[1,i,1]:=8;
for j:=2 to k do a[1,1,j]:=8;
for i:=2 to k do
for j:=2 to k do
a[1,i,j]:=5;
{--------- 2..k ryad ----------}
for m:=2 to k do
begin
a[m,1,1]:=8;
for i:=2 to k do a[m,i,1]:=5;
for j:=2 to k do a[m,1,j]:=5;
for i:=2 to k do
for j:=2 to k do
a[m,i,j]:=3;
end;
rez:=0; count:=0; flag:=true;
for m:=1 to k-1 do
for i:=1 to k-1 do
for j:=1 to k-1 do
begin
rez:=rez+a[m,i,j];
inc(count);
end;
{------------------------------------}
l:=n-count;
j:=k;
p:=1;s:=1;
while s<l do
begin
inc(p);
s:=p*p;
end;
if p>k-1 then p:=k-1;
i:=1;
while (i<=p) and flag do
begin
m:=1;
while (m<=p) and flag do
begin
rez:=rez+a[m,i,j];
inc(count);
if count=n then flag:=false;
inc(m);
end;
inc(i);
end;
{+++++++++++++++++++++++++++++++++++++++++}
l:=n-count;
i:=k;
p:=1;s:=1;
while s<l do
begin
inc(p);
s:=p*p;
end;
if p>k-1 then p:=k-1;
j:=1;
while (j<=p) and flag do
begin
m:=1;
while (m<=p) and flag do
begin
rez:=rez+a[m,i,j];
inc(count);
if count=n then flag:=false;
inc(m);
end;
inc(j);
end;
{+++++++++++++++++++++++++++++++++++++++++}
i:=k; j:=k; m:=1;
while (m<k) and flag do
begin
rez:=rez+a[m,i,j];
inc(count);
if count=n then flag:=false;
inc(m);
end;
{------------------------------------}
l:=n-count;
m:=k;
p:=1;s:=1;
while s<l do
begin
inc(p);
s:=p*p;
end;
i:=1;
while (i<=p) and flag do
begin
j:=1;
while (j<=p) and flag do
begin
rez:=rez+a[m,i,j];
inc(count);
if count=n then flag:=false;
inc(j);
end;
inc(i);
end;
{------------------------------------}
if n=0 then writeln (0) else writeln (rez);
end.
Поделиться42016-03-22 23:22:19
Задача №4 Две окружности
Определить количество точек пересечения двух окружностей.
var x1,y1,r1,x2,y2,r2, x12:real;
begin
readln (x1,y1,r1,x2,y2,r2);
x12:=sqr(x1-x2)+sqr(y1-y2);
if (x1=x2) and (y1=y2) and (r1=r2) then writeln (-1) else
if sqr(r1+r2)=x12 then writeln (1) else
if sqr(r1-r2)=x12 then writeln (1) else
if sqr(r1+r2)<x12 then writeln (0) else
if sqr(r1-r2)>x12 then writeln (0) else
if (sqr(r1+r2)>x12) or (sqr(r1-r2)<x12) then writeln (2);
end.
Поделиться52016-03-22 23:30:51
Задача №7 Римские числа
Посчитать сумму двух натуральных чисел A и B, записанных в римской системе счисления. Ответ также записать в римской системе счисления.
M = 1000, D = 500, C = 100, L = 50, X = 10, V = 5, I = 1. Все числа – не превышают 2000.
Входные данные
В строке записано два числа в римской системе счисления, между которыми стоит знак + .
Выходные данные
Единственное число – сумма чисел, записанное также в римской системе счисления. Числа в римской системе счисления записаны большими латинскими буквами.
Program n7;
var t,r1,r2,r: string;
a,b: array[1..20] of integer;
L,i,k,s1,s2,s: longint;
Begin
readln(t);
L:=length(t);
for i:=1 to L do
if t[i]='+' then k:=i;
for i:=1 to k-1 do
begin
if t[i]='M' then a[i]:=1000;
if t[i]='D' then a[i]:=500;
if t[i]='C' then a[i]:=100;
if t[i]='L' then a[i]:=50;
if t[i]='X' then a[i]:=10;
if t[i]='V' then a[i]:=5;
if t[i]='I' then a[i]:=1;
end;
for i:=k+1 to L do
begin
if t[i]='M' then b[i-k]:=1000;
if t[i]='D' then b[i-k]:=500;
if t[i]='C' then b[i-k]:=100;
if t[i]='L' then b[i-k]:=50;
if t[i]='X' then b[i-k]:=10;
if t[i]='V' then b[i-k]:=5;
if t[i]='I' then b[i-k]:=1;
end;
s1:=a[k-1];
for i:=k-2 downto 1 do
if a[i]<a[i+1]
then s1:=s1-a[i]
else s1:=s1+a[i];
s2:=b[L-k];
for i:=L-k-1 downto 1 do
if b[i]<b[i+1]
then s2:=s2-b[i]
else s2:=s2+b[i];
s:=s1+s2;
r:='';
while s>=1000 do
begin
s:=s-1000;
r:=r+'M';
end;
while s>=900 do
begin
s:=s-900;
r:=r+'CM';
end;
While s>=500 do
begin
s:=s-500;
r:=r+'D'
end;
while s>=400 do
begin
s:=s-400;
r:=r+'CD';
end;
while s>=100 do
begin
s:=s-100;
r:=r+'C';
end;
while s>=90 do
begin
s:=s-90;
r:=r+'XC';
end;
while s>=50 do
begin
s:=s-50;
r:=r+'L'
end;
while s>=40 do
begin
s:=s-40;
r:=r+'XL'
end;
while s>=10 do
begin
s:=s-10;
r:=r+'X';
end;
while s>=9 do
begin
s:=s-9;
r:=r+'IX';
end;
while s>=5 do
begin
s:=s-5;
r:=r+'V'
end;
while s>=4 do
begin
s:=s-4;
r:=r+'IV'
end;
while s>=1 do
begin
s:=s-1;
r:=r+'I';
end;
writeln(r);
end.
Более сложный способ
TYPE DigStr = string[2];
CONST Digs:Array[1..13] of DigStr
= ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
Vals:Array[1..13] of longint
= (1,4,5,9,10,40,50,90,100,400,500,900,1000);
VAR sum:longint;
S, temp, st1, st2:string;
c:char;
FUNCTION Dig(C:char):longint;
begin
case C of
'I':Dig:=1;
'V':Dig:=5;
'X':Dig:=10;
'L':Dig:=50;
'C':Dig:=100;
'D':Dig:=500;
'M':Dig:=1000;
end;
end;
FUNCTION RomanToArab(var S:string):longint;
var Sum,i,Len:longint;
begin
Sum:=0;
i:=1; Len:=length(S);
while i<Len do
begin
if Dig(S[i])<Dig(S[i+1]) then begin
Sum:=Sum+Dig(S[i+1])-Dig(S[i]);
i:=i+1;
end
else Sum:=Sum+Dig(S[i]);
i:=i+1;
end;
if i=Len then Sum:=Sum+Dig(S[Len]);
RomanToArab:=Sum;
end;
FUNCTION ArabToRoman(Num:longint):string;
var S:String;
K,i:longint;
begin
i:=13; S:='';
K:=Num;
while i<>0 do
if K>=Vals[i] then begin
K:=K-Vals[i];
S:=S+Digs[i];
end
else dec(i);
ArabToRoman:=S;
end;
BEGIN
st1:='';
read (c);
while c<>'+' do
begin
st1:=st1+c;
read (c);
end;
st2:='';
while not(eoln) do
begin
read (c);
st2:=st2+c;
end;
sum:=RomanToArab(st1)+RomanToArab(st2);
writeln(ArabToRoman(sum));
END.
Поделиться62016-03-22 23:34:20
Задача №7 Римские числа
Посчитать сумму двух натуральных чисел A и B, записанных в римской системе счисления. Ответ также записать в римской системе счисления.
M = 1000, D = 500, C = 100, L = 50, X = 10, V = 5, I = 1. Все числа – не превышают 2000.
Входные данные
В строке записано два числа в римской системе счисления, между которыми стоит знак + .
Выходные данные
Единственное число – сумма чисел, записанное также в римской системе счисления. Числа в римской системе счисления записаны большими латинскими буквами.
Program n7;
var t,r1,r2,r: string;
a,b: array[1..20] of integer;
L,i,k,s1,s2,s: longint;
Begin
readln(t);
L:=length(t);
for i:=1 to L do
if t[i]='+' then k:=i;
for i:=1 to k-1 do
begin
if t[i]='M' then a[i]:=1000;
if t[i]='D' then a[i]:=500;
if t[i]='C' then a[i]:=100;
if t[i]='L' then a[i]:=50;
if t[i]='X' then a[i]:=10;
if t[i]='V' then a[i]:=5;
if t[i]='I' then a[i]:=1;
end;
for i:=k+1 to L do
begin
if t[i]='M' then b[i-k]:=1000;
if t[i]='D' then b[i-k]:=500;
if t[i]='C' then b[i-k]:=100;
if t[i]='L' then b[i-k]:=50;
if t[i]='X' then b[i-k]:=10;
if t[i]='V' then b[i-k]:=5;
if t[i]='I' then b[i-k]:=1;
end;
s1:=a[k-1];
for i:=k-2 downto 1 do
if a[i]<a[i+1]
then s1:=s1-a[i]
else s1:=s1+a[i];
s2:=b[L-k];
for i:=L-k-1 downto 1 do
if b[i]<b[i+1]
then s2:=s2-b[i]
else s2:=s2+b[i];
s:=s1+s2;
r:='';
while s>=1000 do
begin
s:=s-1000;
r:=r+'M';
end;
while s>=900 do
begin
s:=s-900;
r:=r+'CM';
end;
While s>=500 do
begin
s:=s-500;
r:=r+'D'
end;
while s>=400 do
begin
s:=s-400;
r:=r+'CD';
end;
while s>=100 do
begin
s:=s-100;
r:=r+'C';
end;
while s>=90 do
begin
s:=s-90;
r:=r+'XC';
end;
while s>=50 do
begin
s:=s-50;
r:=r+'L'
end;
while s>=40 do
begin
s:=s-40;
r:=r+'XL'
end;
while s>=10 do
begin
s:=s-10;
r:=r+'X';
end;
while s>=9 do
begin
s:=s-9;
r:=r+'IX';
end;
while s>=5 do
begin
s:=s-5;
r:=r+'V'
end;
while s>=4 do
begin
s:=s-4;
r:=r+'IV'
end;
while s>=1 do
begin
s:=s-1;
r:=r+'I';
end;
writeln(r);
end.
Более сложный способ
TYPE DigStr = string[2];
CONST Digs:Array[1..13] of DigStr
= ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
Vals:Array[1..13] of longint
= (1,4,5,9,10,40,50,90,100,400,500,900,1000);
VAR sum:longint;
S, temp, st1, st2:string;
c:char;
FUNCTION Dig(C:char):longint;
begin
case C of
'I':Dig:=1;
'V':Dig:=5;
'X':Dig:=10;
'L':Dig:=50;
'C':Dig:=100;
'D':Dig:=500;
'M':Dig:=1000;
end;
end;
FUNCTION RomanToArab(var S:string):longint;
var Sum,i,Len:longint;
begin
Sum:=0;
i:=1; Len:=length(S);
while i<Len do
begin
if Dig(S[i])<Dig(S[i+1]) then begin
Sum:=Sum+Dig(S[i+1])-Dig(S[i]);
i:=i+1;
end
else Sum:=Sum+Dig(S[i]);
i:=i+1;
end;
if i=Len then Sum:=Sum+Dig(S[Len]);
RomanToArab:=Sum;
end;
FUNCTION ArabToRoman(Num:longint):string;
var S:String;
K,i:longint;
begin
i:=13; S:='';
K:=Num;
while i<>0 do
if K>=Vals[i] then begin
K:=K-Vals[i];
S:=S+Digs[i];
end
else dec(i);
ArabToRoman:=S;
end;
BEGIN
st1:='';
read (c);
while c<>'+' do
begin
st1:=st1+c;
read (c);
end;
st2:='';
while not(eoln) do
begin
read (c);
st2:=st2+c;
end;
sum:=RomanToArab(st1)+RomanToArab(st2);
writeln(ArabToRoman(sum));
END.
Поделиться72016-03-22 23:45:28
Задача №62 Факториал
Зная значение N! (N!=1*2*...*(N-1)*N) определить значение N.
Const Osn=10000;
MaxDig=2000;
Type TLong=Array [0..MaxDig] of longint;
Var p, r:Tlong;
rez, t, max, ii, tt, code:integer;
f:text;
st:string;
Procedure ReadLong (var A:TLong);
Var ch:char; i:integer;
Begin
Read (ch);
While ch in ['0'..'9'] Do
Begin
For i:=A[0] DownTo 1 Do
Begin
A[i+1]:=A[i+1]+(A[i]*10) div Osn;
A[i]:= (A[i]*10) mod Osn;
End;
A[1]:=A[1]+Ord(ch)-48;
If A[A[0]+1]>0 Then Inc (A[0]);
Read (ch);
End;
End;
Procedure WriteLong (Const A:TLong);
Var ls, s:string;
i:integer;
Begin
Str (Osn div 10, ls);
Write (A[A[0]]);
For i:=A[0]-1 DownTo 1 Do
Begin
Str (A[i], s);
While Length (s)<Length (ls) do
s:='0'+s;
Write (s);
End;
Writeln;
End;
Procedure Mul (A:TLong; k:integer; Var C:TLong);
Var i:integer;
Begin
fillchar (c,maxdig,0);
If k=0 Then Inc(C[0])
Else Begin
For i:=1 To A[0] Do
Begin
C[i+1]:=(Longint(A[i]*k)+C[i]) Div Osn;
C[i]:=(Longint(A[i]*k)+C[i]) Mod Osn;
End;
If C[A[0]+1]>0 Then C[0]:=A[0]+1
Else C[0]:=A[0];
End;
End;
function check(A, B:TLong) :boolean;
var ii:integer;
begin
check:=false;
ii:=0;
while (a[ii]=b[ii]) and (ii<2001) do
begin
inc(ii);
end;
if ii=2001 then check:=true;
end;
BEGIN
ReadLong(r);
if (r[0]=1) and (r[1]=1) then rez:=1
else begin
p[0]:=1; p[1]:=1;
rez:=1;
repeat
inc(rez);
Mul (p,rez,p);
until check(p, r);
end;
Writeln (rez);
END.
Поделиться82016-03-22 23:51:45
Задача №905 Какой треугольник?
Определить вид треугольника (равносторонний, равнобедренный, разносторонний) по заданным длинам его сторон.
Входные данные
В одной строке задано 3 целых числа - длины сторон треугольника. Длины сторон не превышают 100.
Выходные данные
Вывести 1, если треугольник равносторонний, 2 если равнобедренный и 3 если разносторонний.
var a,b,c:longint;
begin
readln(a,b,c);
if (a=b) and (a=c) and (b=c) then writeln(1);
if (a=b) and (a<>c) and (b<>c) then writeln(2);
if (a<>b) and (a=c) and (b<>c) then writeln(2);
if (a<>b) and (a<>c) and (b=c) then writeln(2);
if (a<>b) and (a<>c) and (b<>c) then writeln(3);
end.
Поделиться92016-03-22 23:56:28
Задача №73 Числа Фибоначчи
Какое наибольшее число Фибоначчи можно составить, имея в своем распоряжении набор цифр C0, C1, C2, … C9, где C0 - количество цифр 0, C1 - количество цифр 1, … C9 – количество цифр 9.
Входные данные
В единственной строке записано 10 целых чисел, каждое из которых соответствует количеству соответствующих цифр в имеющемся наборе. Все входные данные не превышают 100.
Выходные данные
Одно число – номер числа Фибоначчи, или -1, если такое числа составить невозможно.
Const MaxDig=1010;
Osn=10;
Type Tlong=Array [0..MaxDig] of longint;
var a:array[0..10000] of tlong;
b, c:array [0..9] of longint;
a1, a2, fib:tlong;
i, sc, rez:longint;
function check:boolean;
var j, sumb:integer;
begin
fillchar (b,sizeof(b),0);
for j:=1 to fib[0] do
inc (b[fib[j]]);
check:=true;
for j:=0 to 9 do
if b[j]>c[j] then begin check:=false; exit; end;
end;
Procedure SumLongTwo (t, p:Tlong; Var s:Tlong);
Var i, k:Integer;
Begin
FillChar (s, Sizeof(s), 0);
If t[0]>p[0] Then k:=t[0] Else k:=p[0];
For i:=1 to k Do
Begin
s[i+1]:=(t[i]+p[i]+s[i]) div Osn;
s[i]:=(t[i]+p[i]+s[i]) Mod Osn;
End;
If s[k+1]=0 Then s[0]:=k Else s[0]:=k+1;
End;
begin
sc:=0;
for i:=0 to 9 do
begin
read (c[i]);
sc:=sc+c[i];
end;
a[1][0]:=1; a[1][1]:=1;
a[2][0]:=1; a[2][1]:=1;
rez:=2; i:=2;
while (a[i][0]<=sc) do
begin
inc (i);
sumlongtwo (a[i-2], a[i-1], a[i]);
inc(rez);
end;
fib:=a[i-1];
while not(check) do
begin
i:=i-1;
fib:=a[i];
dec(rez);
end;
if rez>0 then writeln (rez)
else writeln (-1);
end.
Поделиться102016-03-23 01:15:12
Помогите пожалуйста.
Прямоугольник
Зная координаты трех вершин прямоугольника на координатной плоскости, определить координаты четвертой вершины.
Входные данные
В одной строке записаны шесть чисел – координаты трех вершин прямоугольника. Числа целые, по модулю не превышают 100.
Выходные данные
Два целых числа - координаты четвертой вершины прямоугольника.
Поделиться112016-03-23 01:17:25
Program n7379;
var x1,y1,x2,y2,x3,y3,x4,y4,a,b,c: longint;
begin
readln(x1,y1,x2,y2,x3,y3);
a:=(x2-x1)*(x2-x1)+(y2-y1)*(y2-y1);
b:=(x3-x2)*(x3-x2)+(y3-y2)*(y3-y2);
c:=(x1-x3)*(x1-x3)+(y1-y3)*(y1-y3);
if (a>b) and (a>c)
then begin
x4:=x1+x2-x3;
y4:=y1+y2-y3
end;
if (b>a) and (b>c)
then begin
x4:=x2+x3-x1;
y4:=y2+y3-y1
end;
if (c>a) and (c>b)
then begin
x4:=x3+x1-x2;
y4:=y3+y1-y2
end;
writeln(x4,' ',y4);
end.
Поделиться122016-03-23 01:19:15
Спасибо!
Поделиться132016-03-23 01:23:16
2501
Круговая диаграмма
Для графического изображения соотношения между различного рода величинами во многих областях человеческой деятельности используются различные графики и диаграммы. Одним из типов диаграмм является так называемая круговая диаграмма.
Исходными данными для этой диаграммы является набор чисел a1, ..., an, а диаграмма представляет собой круг радиуса r, разделенный на секторы. При этом каждому из чисел соответствует ровно один сектор, площадь которого пропорциональна этому числу. Общая площадь секторов равна площади круга.
Ваша задача состоит в том, чтобы по набору чисел и по радиусу круга определить площадь каждого из секторов круговой диаграммы.
Входные данные
Первая строка содержит два целых числа n и r (1 ≤ n, r ≤ 100). Вторая строка содержит n целых чисел a1, ..., an (1 ≤ ai ≤ 100 для всех i от 1 до n).
Выходные данные
Выведите n вещественных чисел — площади секторов, соответствующих числам a1, ..., an. Выводите каждое из чисел в отдельной строке. Все эти числа должны быть выведены с точностью не хуже 10-6.
Program 2501;
var n,r,i,k: integer;
sp: real;
a: array[1..100] of integer;
s: array[1..100] of real;
Begin
readln(n,r);
sp:=Pi*r*r;
k:=0;
for i:=1 to n do
begin
read(a[i]);
k:=k+a[i];
end;
for i:=1 to n do
begin
s[i]:=sp*a[i]/k;
writeln(s[i]:9:7);
end;
end.
Отредактировано Ваня Козаченко (2016-03-23 01:24:31)
Поделиться142016-03-23 20:27:00
№ 22
"Зеркально простые" числа
Назовем число "зеркально простым", если само число является простым, и простым является число, записанное теми же цифрами в обратном порядке.
На заданном промежутке [A, B] найти количество "зеркально простых" чисел.
var t:string;
c:char;
code:word;
a, b, rez, i, mm, j, ti, temp:longint;
flag:boolean;
function proste(t:longint):boolean;
var s, i, k, j:longint;
begin
proste:=false;
if t=1 then proste:=false else
if t=2 then proste:=true
else begin
k:=0;
for i:=2 to trunc(sqrt(t)) do
if t mod i = 0 then k:=k+1;
if k=0 then proste:=true;
end;
end;
BEGIN
readln (a, b);
if a>b then begin i:=a; a:=b; b:=i; end;
rez:=0;
for i:=a to b do
begin
if proste(i) then
begin
t:=''; temp:=i;
while temp>0 do
begin
t:=t+chr((temp mod 10) +48);
temp:=temp div 10;
end;
val(t, ti, code);
if proste(ti) then inc (rez);
end;
end;
writeln (rez);
END.
Поделиться152016-03-24 00:28:46
58 Биллиард
Биллиард представляет собой прямоугольник размерами M x N, где M и N – натуральные числа. Из верхней левой лузы вылетает шар под углом 450 к соседним сторонам. Лузы размещено только в углах биллиарда. Определите количество столкновений шара с бортами биллиарда, после которых он опять попадет в одну из луз, и номер лузы, в которую упадет шар. Считать, что трение отсутствует, столкновения абсолютно упругие, а шар - материальная точка.
var m, n, m1, n1, km, kn:int64;
nsk, rez, luza: int64;
function NSD(x, y:int64):int64;
begin
while (x<>0) and (y<>0) do
if x>=y then x:=x mod y
else y:=y mod x;
NSD:=x+y;
end;
begin
readln (m1, n1);
rez:=0;
m:=m1 div nsd (m1, n1);
n:=n1 div nsd (m1, n1);
nsk:=(m div nsd(m, n))*n;
km:=nsk div m;
kn:=nsk div n;
if (km mod 2=0) and (kn mod 2=1) then luza:=4;
if (km mod 2=1) and (kn mod 2=0) then luza:=2;
if (km mod 2=1) and (kn mod 2=1) then luza:=3;
rez:=km-1+kn-1;
writeln (rez, ' ',luza);
end.
Поделиться162016-03-24 00:30:01
49 Кот учёный
Уезжая из дома, поэт оставлял коту, прикованному к дубу цепью длиной L,N рыбин. Зная координаты головы и хвоста каждой из них, подсчитайте, на какие сутки у кота визникнет чувство голода, если оно возникает тогда, когда за сутки он съест меньше, чем K рыбин. Рыбину он может съесть, если сможет дотянуться хотя бы к одной её точке. Координаты дуба (0, 0).
c:=x1*y2-y1*x2;
if (a=0) and (b<>0) and (not(intro)) then
if l*l-sqr(c/b)>=0 then begin
xp1:=sqrt(l*l-sqr(c/b));
xp2:=-sqrt(l*l-sqr(c/b));
yp1:=y1;
if (x1<=xp1) and (xp1<=x2) or
(x1<=xp2) and (xp2<=x2) or
(x1>=xp2) and (xp2>=x2) or
(x1>=xp1) and (xp1>=x2)
then rez:=rez+1;
end;
if (b=0) and (a<>0) and (not (intro)) then
if l*l-sqr(c/a)>=0 then begin
yp1:=sqrt(l*l-sqr(c/a));
yp2:=-sqrt(l*l-sqr(c/a));
xp1:=x1;
if (y1<=yp1) and (yp1<=y2) or
(y1<=yp2) and (yp2<=y2) or
(y1>=yp2) and (yp2>=y2) or
(y1>=yp1) and (yp1>=y2)
then rez:=rez+1;
end;
if (a<>0) and (b<>0) and (not(intro)) then
begin
d:=b*b*l*l-c*c+a*a*l*l;
if d>=0 then begin
yp1:=(b*c+a*sqrt(d))/(a*a+b*b);
xp1:=(c-b*yp1)/a;
yp2:=(b*c-a*sqrt(d))/(a*a+b*b);
xp2:=(c-b*yp2)/a;
if (x1<=xp1) and (xp1<=x2) and
(y1<=yp1) and (yp1<=y2) or
(x1>=xp1) and (xp1>=x2) and
(y1<=yp1) and (yp1<=y2) or
(x1>=xp1) and (xp1>=x2) and
(y1>=yp1) and (yp1>=y2) or
(x1<=xp1) and (xp1<=x2) and
(y1>=yp1) and (yp1>=y2)
then rez:=rez+1;
end;
end;
end;
end;
Поделиться172016-03-24 00:31:09
47 Паркет из треугольников
Прямоугольную комнату размерами M на N(сначала по горизонтали, а потом по вертикали) замостили треугольными плитками и их пронумеровали, как показано на рисунке.
За один шаг можно переместиться с одной паркетины на другую только через общую сторону. Найти наименьшее количество шагов, нужных для перемещения с паркетины A на паркетину B.
var m, n, xp, yp, xk, yk, st, fin, temp, rez :longint;
begin
readln (n, m);
readln (st, fin);
if n=1 then begin
rez:=abs(st-fin);
writeln (rez); halt;
end;
if m=1 then begin
rez:=abs(st-fin);
writeln (rez); halt;
end;
if st>fin then begin temp:=st; st:=fin; fin:=temp; end;
xp:=((st-1) div (2*n))+1;
yp:=(((st-1) mod (2*n)) div 2)+1;
xk:=((fin-1) div (2*n))+1;
yk:=(((fin-1) mod (2*n)) div 2)+1;
if (xp=xk) then
begin
rez:=abs(st-fin);
writeln (rez); halt;
end;
if (yp=yk) and (st mod 2 = fin mod 2) then
begin
rez:=abs(xk-xp)*2;
writeln (rez); halt;
end;
if (yp=yk) and (st mod 2 =0) and (fin mod 2=1) then
begin
rez:=abs(xk-xp)*2-1;
writeln (rez); halt;
end;
if (yp=yk) and (st mod 2 =1) and (fin mod 2=0) then
begin
rez:=abs(xk-xp)*2+1;
writeln (rez); halt;
end;
if (xp<xk) and (yp<yk) and (st mod 2 = fin mod 2) then
begin
rez:=abs(xk-xp)*2+abs(yk-yp)*2;
writeln (rez); halt;
end;
if (xp<xk) and (yp<yk) and (st mod 2 =0) and (fin mod 2=1) then
begin
rez:=abs(xk-xp)*2+abs(yk-yp)*2-1;
writeln (rez); halt;
end;
if (xp<xk) and (yp<yk) and (st mod 2 =1) and (fin mod 2=0) then
begin
rez:=abs(xk-xp)*2+abs(yk-yp)*2+1;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp=xk+yk) and (st mod 2 = fin mod 2) then
begin
rez:=abs(yk-yp)*2;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp>xk+yk) and (st mod 2 = fin mod 2) then
begin
rez:=abs(xk-xp)*2;
yp:=yp-abs(xp-xk);
rez:=rez+abs(yp-yk)*2;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp>xk+yk) and (st mod 2=0) and (fin mod 2=1) then
begin
rez:=abs(xk-xp)*2;
yp:=yp-abs(xp-xk);
rez:=rez+abs(yp-yk)*2+1;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp>xk+yk) and (st mod 2=1) and (fin mod 2=0) then
begin
rez:=abs(xk-xp)*2;
yp:=yp-abs(xp-xk);
rez:=rez+abs(yp-yk)*2-1;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp<xk+yk) and (st mod 2 = fin mod 2) then
begin
rez:=abs(yk-yp)*2;
xp:=xp+abs(yp-yk);
rez:=rez+abs(xp-xk)*2;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp<xk+yk) and (st mod 2=0) and (fin mod 2=1) then
begin
rez:=abs(yk-yp)*2;
xp:=xp+abs(yp-yk);
rez:=rez+abs(xp-xk)*2-1;
writeln (rez); halt;
end;
if (xp<xk) and (yp>yk) and (xp+yp<xk+yk) and (st mod 2=1) and (fin mod 2=0) then
begin
rez:=abs(yk-yp)*2;
xp:=xp+abs(yp-yk);
rez:=rez+abs(xp-xk)*2+1;
writeln (rez); halt;
end;
end.
Поделиться182016-03-24 00:32:21
63 Анфиса и цветы
Мурзик одну из цветочных клумб сделал в виде шахматной доски размерами M на N, в каждой клеточке которой растет какой-то цветок. Иногда на эту клумбу он выводит на прогулку Анфису (да, не удивляйтесь, они действительно друзья). Анфиса, начиная всегда с верхнего левого угла передвигается по клумбе к правому нижнему и собирает цветы, причем таким образом, чтобы каждый раз проходить новым маршрутом, а Мурзик на выходе вручает ей кусочек сыра.
Посчитать, какое наибольшее количество кусочков сыра получит Анфиса, если она все время старается сохранить как можно больше цветов.
VAR a, b:int64;
begin
readln (m,n);
writeln ((m-1)*(n-1)+1);
end.
Поделиться192016-03-24 00:33:58
51 Стоимость К-домино
Работник отдела технического контроля любил выбраковывать "доминошки", которые содержали одинаковые значения. Так как на предприятии, выпускающем K-домино, этого не знали, к нему постоянно поступали претензии на сумму, равную стоимости K-домино. Стоимость K-домино составляла ровно столько гривен, сколько было в купленном покупателем наборе доминошек.
Для того, чтобы его не уволили с работы, работник ОТК выбраковывал иногда не только все не любимые "доминошки", а несколько больше, но не более половины гарантированно выбраковыванных.
Зная сумму претензии, пришедшей на предприятие, установите, какой из наборов K-домино был куплен покупателем.
var s, n, k, t:longint;
begin
readln (s);
if s=0 then begin writeln (0); halt; end;
k:=0; t:=1;
while t<s do
begin
k:=k+1;
t:=t+k+1;
end;
if s<=t then inc(k);
writeln (k);
end.
Поделиться202016-03-24 00:35:00
75 Пираты и монеты
N пиратам удалось справедливо разделили клад из M золотых монет - каждый получил свою часть согласно своему пиратскому рангу и стажу. Самый молодой пират взял A монет, а каждый следующий пират брал на одну монету больше, чем предыдущий его коллега. Последним был капитан, которому досталось вдвое больше от запланированного, очевидно, что после него монет больше не осталось.
Сколько было пиратов вместе с капитаном, если известны A и M.
Так как капитан без команды просто пират, то N > 1.
var s, a, i, r, k, m:int64;
begin
readln (a, m);
s:=0;
i:=a;
s:=s+i;
r:=m-s; k:=1;
while r div i<>2 do
begin
i:=i+1;
s:=s+i;
r:=m-s;
inc(k);
end;
writeln (k+1);
end.
Поделиться212016-03-24 00:36:05
11 Большая точность
Дана рациональная дробь m/n. Запишете её в виде десятичной дроби с точностью k знаков после запятой.
var j, t, m, n, k:longint;
a:array[0..1001] of integer;
begin
readln (m, n, k);
t:=1;
a[0]:=m div n;
m:=(m mod n)*10;
repeat
a[t]:=m div n;
m:=(m mod n)*10;
inc(t);
until t>k+1;
if k=0 then begin writeln (a[0]); halt; end;
write (a[0], '.');
for j:=1 to k do
write (a[j]);
writeln;
end.
Поделиться222016-03-24 01:12:11
54 Мурзик
Весна… Прекрасное время! Все, казалось бы оживает и двигается, расцветает, начинается новый проход цикла жизни. И общеизвестный Мурзик не является исключением! Но если он чрезвычайно активен днем – то точно так же крепко спит ночью. Причем несчастный хищник видит преимущественно кошмары…
Одной ночью ему приснилось, что он судья на математических соревнованиях крыс(да, в наш век цифровых технологий даже крысы не остаются за гранью научно-технического прогресса). Соревнования проводятся среди N команд по Kкрыс в каждой. Соревнования проводятся в К раундов, в каждом из которых представитель команды называет число. Побеждает та команда, у которой произведение всех чисел наибольшее. Почему крысы не называют каждый раз максимально возможное число? На то они и крысы, что в отличии от Мурзика, обделены интеллектом. Но и Мурзик понимает, что сам подсчитать результат не сможет из-за недостачи математических способностей и поэтому просит вашей помощи.
var a:array[1..20] of extended;
b:array[1..20] of longint;
n, k, i, j, p, rez:longint;
t, max:extended;
begin
readln (n, k);
for i:=1 to n do
a[i]:=1.0;
for i:=1 to n do
b[i]:=0;
for i:=1 to k do
begin
for j:=1 to n do
begin
read (t);
if t=0 then a[j]:=0
else if t=-1 then inc (b[j])
else if t<0 then begin
a[j]:=a[j]*abs(t);
b[j]:=b[j]+1;
end
else if t<>1 then
a[j]:=a[j]*abs(t);
end;
if i mod 20 = 0 then for p:=1 to n do
if a[p]<>0 then a[p]:=abs(ln(a[p]));
end;
for i:=1 to n do
if b[i] mod 2 = 1 then a[i]:=a[i]*(-1);
rez:=1; max:=a[1];
for i:=2 to n do
if a[i]>=max then begin max:=a[i]; rez:=i; end;
writeln (rez);
end.
Поделиться232016-03-24 01:14:09
67 Новое блюдо Анфисе - 2
При разрезании сыра в задаче «Сыр для Анфисы» у хозяина оставались куски сира в виде прямоугольного параллелепипеда с разными целыми длинами сторон. Готовя новое блюдо из сыра для Анфисы хозяину приходилось разрезать эти куски на кубики со стороной 1. Какое наименьшее количество разрезов приходилось ему делать для того, чтобы разрезать заданные куски сыра, если он каждый раз разрезал один кусок сыра на две части.
Const NMax = 30;
Type Digit = 0..9; DlChislo = Array[1..Nmax] Of Digit;
Var S : String;
M, N, R, F, K : DlChislo;
I, MaxF : Word;
Logic : Boolean;
c:char;
Procedure Zero(Var A : DlChislo);
Var I : Integer;
Begin
For I := 1 To NMax Do A[i] := 0;
End;
Function Dlina(C : DlChislo) : Integer;
Var I : Integer;
Begin
I := NMax;
While (I > 1) And (C[i] = 0) Do I := I - 1;
Dlina := I
End;
Procedure Print(A : DlChislo);
Var I : Integer;
Begin
For I := Dlina(A) DownTo 1 Do Write(A[i] : 1);
WriteLn;
End;
Procedure Translate(S : String; Var A : DlChislo;
Var OK : Boolean);
Var I : Word;
Begin
Zero(A); I := Length(S); OK := True;
While (I >= 1) And OK Do
Begin
If S[i] In ['0'..'9']
Then A[Length(S) - I+ 1] := Ord(S[i]) - 48
Else OK := False;
I := I - 1
End
End;
Procedure Multiplication(A, B : DlChislo; Var C : DlChislo);
Var I, J : Integer; P : Digit; VspRez : 0..99;
Begin
Zero(C);
For I := 1 To Dlina(A) Do
Begin P := 0;
For J := 1 To Dlina(B) Do
Begin
VspRez := A[i] * B[J] + P + C[I + J - 1];
C[I + J - 1] := VspRez Mod 10;
P := VspRez Div 10
End;
C[I + J] := P
End
End;
Begin
s:='';
read(c);
while c in ['0'..'9'] do begin s:=s+c; read (c); end;
Translate(S, M, Logic);
s:='';
read(c);
while c in ['0'..'9'] do begin s:=s+c; read (c); end;
Translate(S, N, Logic);
s:='';
read(c);
while c in ['0'..'9'] do begin s:=s+c; read (c); end;
Translate(S, K, Logic);
Multiplication(M, N, R);
Multiplication(R, K, R);
i:=1;
while not(r[i]-1>=0) do begin r[i]:=9; i:=i+1; end;
r[i]:=r[i]-1;
Print(R);
End.
Поделиться242016-03-24 01:17:34
70 Пчелы труженицы
Не секрет, что самые трудолюбивые в мире - пчелы. Только некоторые труженицы пчелки присматривают за собранным медом. В нашем улье были установлены следующие правила.
Каждая пчела имела свою рабочую территорию, которая зависела от ее ранга.
Пчела первого ранга имела территорию 1 соту(шестиугольник), 2-го – 7 сот (одна сота и вокруг нее еще 6 сот), третьего рангу – 19 сот – одна сота + 6 сот вокруг + еще 12 сот вокруг. То есть в распоряжении пчелы K-того ранга была фигура, образованная из шестиугольников, радиусом K – шестиугольников.
Нумерация сот начинается с левой нижней соты, и происходит в н
аправлении левой-нижней стороны по рядах (см. рисунок).
Для присмотра за каждой сотой пчелка двигается из соты под номером 1 к соте под номером N, но каждый раз другим путем, чтобы параллельно контролировать и остальные соты. Чтобы попасть из первой соты в N-тую пчелка решила двигаться одним из трех направлений: вверх, вверх-вправо и вниз-вправо. Сколькими способами пчелка с рангом K может попасть из соты с номером 1 в соту под номером N?
var a, c:array[0..27,0..27] of int64;
b:array[0..27,0..27] of boolean;
count, r, n, i, j, max:longint;
rez:int64;
procedure out;
begin
writeln (rez);
end;
begin
readln (r, n);
fillchar (a, sizeof(a), 0);
fillchar (c, sizeof(c), 0);
fillchar (b, sizeof(b), false);
max:=1;
for i:=2 to r do
max:=max+6*(i-1);
if n>max then begin rez:=0; out; halt; end;
count:=1;
for i:=1 to r do
for j:=1 to r+i-1 do
begin
a[i,j]:=count;
b[i,j]:=true;
inc (count);
end;
for i:=r+1 to r+r-1 do
for j:=i-r+1 to r+r-1 do
begin
a[i,j]:=count;
b[i,j]:=true;
inc (count);
end;
for i:=1 to r do
begin
c[1,i]:=1;
c[i,1]:=1;
end;
for i:=2 to 2*r-1 do
for j:=2 to 2*r-1 do
if b[i,j] then
c[i,j]:=c[i-1,j]+c[i,j-1]+c[i-1,j-1];
for i:=1 to 2*r-1 do
for j:=1 to 2*r-1 do
if a[i,j]=n then rez:=c[i,j];
out;
end.
Отредактировано Алекс Гонг (2016-03-24 01:18:17)
Страница: 1