Форум программистов

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » Форум программистов » Форум программистов » Решение задач с сайта e-olimp.com


Решение задач с сайта e-olimp.com

Сообщений 1 страница 24 из 24

1

Здесь вы можете увидеть решение некоторых задач с сайта e-olimp.com

Программы

0

2

Задача №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.

0

3

Задача №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.

0

4

Задача №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.

0

5

Задача №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.

0

6

Задача №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.

0

7

Задача №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.

0

8

Задача №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.

0

9

Задача №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.

0

10

Помогите пожалуйста.

Прямоугольник

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

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

В одной строке записаны шесть чисел – координаты трех вершин прямоугольника. Числа целые, по модулю не превышают 100.

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

Два целых числа - координаты четвертой вершины прямоугольника.

0

11

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.

0

12

Спасибо!

0

13

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)

0

14

№ 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.

0

15

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.

0

16

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;

0

17

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.

0

18

63 Анфиса и цветы
Мурзик одну из цветочных клумб сделал в виде шахматной доски размерами M на N, в каждой клеточке которой растет какой-то цветок. Иногда на эту клумбу он выводит на прогулку Анфису (да, не удивляйтесь, они действительно друзья). Анфиса, начиная всегда с верхнего левого угла передвигается по клумбе к правому нижнему и собирает цветы, причем таким образом, чтобы каждый раз проходить новым маршрутом, а Мурзик на выходе вручает ей кусочек сыра.
Посчитать, какое наибольшее количество кусочков сыра получит Анфиса, если она все время старается сохранить как можно больше цветов.

VAR a, b:int64;
begin
     readln (m,n);
     writeln ((m-1)*(n-1)+1);
end.

0

19

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.

0

20

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.

0

21

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.

0

22

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.

0

23

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.

0

24

70 Пчелы труженицы
   Не секрет, что самые трудолюбивые в мире - пчелы. Только некоторые труженицы пчелки присматривают за собранным медом. В нашем улье были установлены следующие правила.

   Каждая пчела имела свою рабочую территорию, которая зависела от ее ранга.

   Пчела первого ранга имела территорию 1 соту(шестиугольник), 2-го – 7 сот (одна сота и вокруг нее еще 6 сот), третьего рангу – 19 сот – одна сота + 6 сот вокруг + еще 12 сот вокруг. То есть в распоряжении пчелы K-того ранга была фигура, образованная из шестиугольников, радиусом K – шестиугольников.

   Нумерация сот начинается с левой нижней соты, и происходит в нhttp://s2.uploads.ru/t/0iuSr.jpg
http://s2.uploads.ru/t/0iuSr.jpg
аправлении левой-нижней стороны по рядах (см. рисунок).

   Для присмотра за каждой сотой пчелка двигается из соты под номером 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)

0


Вы здесь » Форум программистов » Форум программистов » Решение задач с сайта e-olimp.com


Рейтинг форумов | Создать форум бесплатно © 2007–2017 «QuadroSystems» LLC