Кращі розв'язки учасників першого туру вищої ліги
Задача 1. ( Димко Денис - учень 11 класу Приватного НВК "Антей" м. Кам'янця-Подільського)
var ch:char;
a:array [0..1000] of byte;
i,j,k,la:longint;
fi,fo:text;
Begin
Assign(fi,'number.dat'); reset(fi);
Assign(fo,'number.sol'); rewrite(fo);
while not eoln(fi) do
begin
Read(fi,ch);
inc(la);
a[la]:=byte(ch)-48;
end;
for i:=(la+1) div 2 downto 1 do
if a[i]<>a[la-i+1] then break;
if a[i]<a[la-i+1] then
begin
for j:=(la+1) div 2 downto 1 do
begin
if a[j]<>9 then break;
a[j]:=0;
end;
inc(a[j]);
end;
for i:=(la+1) div 2+1 to la do a[i]:=a[la-i+1];
for i:=1 to la do write(fo,a[i]);
Close(fi); Close(fo);
End.
Задача 2. (Зубик Тарас - учень 9 класу Летавського НВК Чемеровецького району)
{$I-,Q-,R-,S-,N+}
VAR n,k :longint;
a,b :array[-20..155]of extended;
f :text;
Procedure INIT;
begin
assign(f,'inverse.dat'); reset(f);
readln(f,n,k);
close(f);
end;
Procedure OUT;
begin
assign(f,'inverse.sol'); rewrite(f);
if k=-1 then writeln(f,0)
else writeln(f,a[k]:0:0);
close(f);
end;
Procedure SOLVE;
var i,j,r,t :longint;
begin
if ((n-1)*n) div 2<k then begin k:=-1; exit; end;
a[0]:=1;
for i:=2 to n do begin
r:=(((i-1)*i) div 2)+1; t:=-1*i;
b:=a;
for j:=0 to r do begin
a[j]:=a[j-1]+b[j]-b[t];
inc(t);
end;
end;
end;
BEGIN
INIT;
SOLVE;
OUT;
END.
Задача 3. (Власов Денис - учень 11 класу Приватного НВК "Антей" м. Кам'янця-Подільського)
{$I-,Q-,R-,S-}
Const
fi_name = 'chase.dat';
fo_name = 'chase.sol';
MAX_V = 55;
Var
fi, fo : text;
f, c : array [0..MAX_V, 0..MAX_V] of integer;
queue, prev : array [0..MAX_V] of integer;
flag : array [0..MAX_V] of boolean;
countV, countE, source, target : integer;
procedure putFlow;
Var
curr : integer;
begin
curr := target;
while curr <> source do
begin
f[prev[curr], curr] := f[prev[curr], curr] + 1;
f[curr, prev[curr]] := f[curr, prev[curr]] - 1;
curr := prev[curr];
end;
end;
function findPath : boolean;
var
i, curr, qb, qc : integer;
begin
qb := 1; qc := 1; queue[1] := source; prev[target] := -1;
for i := 1 to countV do flag[i] := false;
flag[source] := true;
while (prev[target] = -1) and (qb <= qc) do
begin
curr := queue[qb];
for i := 1 to countV do
if (c[curr, i]-f[curr, i] > 0) and (not flag[i]) then
begin
inc(qc); queue[qc] := i;
prev[i] := curr;
flag[i] := true;
end;
inc(qb);
end;
if prev[target] <> -1 then
begin
putFlow;
findPath := true;
end
else
findPath := false;
end;
function maxFlow : integer;
Var
mFlow : integer;
begin
mFlow := 0;
while findPath do inc(mFlow);
maxFlow := mFlow;
end;
Var
i, x, y : integer;
begin
assign(fi, fi_name); reset(fi);
assign(fo, fo_name); rewrite(fo);
readln(fi, countV, countE, source, target);
for i := 1 to countE do
begin
readln(fi, x, y);
c[x, y] := 1;
c[y, x] := 1;
end;
writeln(fo, maxFlow);
close(fi); close(fo);
end.