Есть задачи с олимпиады

[imort]

Решите уважаемые программисты олимпиадные задачи. Заранее спасибо

[eoln]

ICQ: 421277094
Недорого, сделаю сегодня.

[DRAgon™]

1) Вроде так надо

uses crt;
var a,b,c,d,V,aV:integer;
BEGIN
readln(d);
readln(a);
readln(b);
readln(c);
V:=A*B*C;
aV:=d*d*d;
Writeln('Кубов может быть - ',V div aV );
END.

2 хотя бы перевернули

[eoln]

Сообщение от DRAgon™

1) Вроде так надо

...
V:=A*B*C;
aV:=d*d*d;
Writeln('Кубов может быть - ',V div aV );
END.

Неа DRAgon™, пусть вход 2 3 3 3
Тогда выдаст ответ 3, хотя на самом деле поместится 1 кубик. Надо по отдельности ширину, длину и высоту высчитывать.

[NioTo]

Задача A "Кубы":

var
  A, B, C, D: Integer;

begin
  ReadLn(D, A, B, C);
  WriteLn((A div D) * (B div D) * (C div D));
end.

[DRAgon™]

Сообщение от eoln

Неа DRAgon™, пусть вход 2 3 3 3
Тогда выдаст ответ 3, хотя на самом деле поместится 1 кубик. Надо по отдельности ширину, длину и высоту высчитывать.

Ну хотя да ,вот тока хотел исправить себя,не успел

[NioTo]

Задача B:

var
  F: Text;
  n, Sum, i, CurNum, Digit: Integer;
  ArmstrongNumbers: Array[1..5] of Integer;
  CurArmNum: Integer = 5;

function Pow(Number, Power: Integer): Integer;
var
  i: Integer;
begin
  Pow := 1;
  for i := 1 to Power do
    Pow := Pow * Number;
end;

begin
  Assign(F, 'input.txt');
  Reset(F);
  ReadLn(F, n);
  Close(F);

  for i := Pow(10, n) - 1 downto 1 do begin
    CurNum := i;
    Sum := 0;

    if i < Pow(10, n - 1) then
      Dec(n);

    while CurNum <> 0 do begin
      Digit := CurNum mod 10;
      Sum := Sum + Pow(Digit, n);
      CurNum := CurNum div 10;
    end;

    if Sum = i then begin
      ArmstrongNumbers[CurArmNum] := Sum;
      Dec(CurArmNum);
    end;
  end;

  Assign(F, 'output.txt');
  Rewrite(F);
  for i := 1 to 4 do
    Write(F, ArmstrongNumbers[i], ' ');
  Write(F, ArmstrongNumbers[5]);
  Close(F);
end.

[DRAgon™]

NioTo , а вам просто так не лень делать?

[NioTo]

Задача C:

var
  F: Text;
  n, i, j: Integer;
  c: Integer = -1;
  Num: Integer = 1;
  Arr: Array of Array of Integer;

begin
  Assign(F, 'input.txt');
  Reset(F);
  ReadLn(F, n);
  Close(F);

  SetLength(Arr, n);
  for i := 0 to n - 1 do
    SetLength(Arr[i], n);

  repeat
    Inc(c);
    for i := c to n - c - 1 do begin
      Arr[c][i] := Num;
      Inc(Num);
    end;
    for i := c + 1 to n - c - 1 do begin
      Arr[i][n - c - 1] := Num;
      Inc(Num);
    end;
    for i := n - c - 2 downto c do begin
      Arr[n - c - 1][i] := Num;
      Inc(Num);
    end;
    for i := n - c - 2 downto c + 1 do begin
      Arr[i][c] := Num;
      Inc(Num);
    end;
  until n div 2 = c;

  Assign(F, 'output.txt');
  Rewrite(F);
  for i := 0 to n - 1 do begin
    for j := 0 to n - 2 do
      Write(F, Arr[i, j], ' ');
    WriteLn(F, Arr[i, n - 1]);
  end;
  Close(F);
end.

DRAgon™, ну мне интересно решать подобные задачи. Было бы не интересно не решал бы и за деньги.

P. S. На седня хватит думаю, спать пора, а завтра на смену, т. ч. только до вечера послезавтра, если надо будет.

[Mad_Cat]

Задача D

var i,j,q,w:integer;
Begin
  Read (q,w);
  For i:=q-2 to q+2 do
    For j:=w-2 to w+2 do
      If ((abs(q-i)=1) and (abs(w-j)=2)) or
         ((abs(q-i)=2) and (abs(w-j)=1)) and
         ((q>=1) and (q<=8)) and ((w>=1) and (w<=8)) then
           If ((i>0) and (j>0)) and ((i<=8) and (j<=8)) then Begin
                                     Writeln (i,' ',j);
                                   End;
End.

задача Е

var
f:textfile;
i:integer;
i1,i2:integer;
n:integer;
a:array[1..20] of integer;
begin
assign(f,'input.txt');
reset (f);
readln(f,n);
i1:=0;
i2:=1;
for i:=1 to n do
begin
read(a[i]);
if not odd(i) then i1:=i1+a[i]
else if a[i]>a[i2] then i2:=i;
end;
close(f);
assign(f,'output.txt');
rewrite (f);
write(f,i1,' ',a[i2]);
close(f);
end.

Задача F

var
f:textfile;
i:integer;
n:integer;
i1:longint;
function fact(k:integer):longint;
var j:integer;
f1:longint;
begin
  f1:=1;
  for j:=2 to k do
   f1:=f1*j;
  fact:=f1;
end
begin
assign(f,'input.txt');
reset (f);
readln(f,n);
i1:=0;
for i:=1 to n do
i1:=i1+fact(i);
close(f);
assign(f,'output.txt');
rewrite (f);
write(f,i1);
close(f);
end.