Ускова О.Ф., Горбенко О.Д. Олимпиадные задачи по программированию. Лучшие решения. Часть 4
Подождите немного. Документ загружается.
курса факультета ПММ ВГУ Шалиткиным Андреем
Владимировичем .
{ Множетели и факториалы }
program mnog;
type mas=array[1..100] of integer;
var
t:text;
n,i:byte;
a:mas;
procedure input(var n:byte;var t:text);
begin
reset(t);
read(t,n);
close(t);
end;
function prost(k:byte):boolean;
var
i:byte;
t:boolean;
begin
i:=2;
t:=true;
while (i<k)and t do
begin
if k mod i=0 then
t:=false;
inc(i);
end;
prost:=t;
end;
procedure razprost(var a:mas;k:byte);
var
i:byte;
begin
i:=2;
while k>1 do
begin
if k mod i=0 then
if prost(i) then
begin
while k mod i =0 do
begin
k:=k div i;
inc(a[i]);
end;
end;
inc(i);
end;
end;
procedure output(var a:mas;var t:text; n:byte);
var i:byte;
begin
rewrite(t);
write(t,n,'! = ');
for i:=2 to n do
if a[i]<>-1 then
write(t,a[i],' ');
close(t);
end;
begin
assign(t,'input.txt');
input(n,t);
for i:=1 to n do
if prost(i) then
a[i]:=0
else
a[i]:=-1;
for i:=2 to n do
razprost(a,i);
assign(t,'ouput.txt');
output(a,t,n);
end.
Другой вариант решения этой же задачи , предложенный
студентом 1 курса факультета компьютерных наук ВГУ
Соломатиным Алексеем .
{Solomatin A.; VSU.FCS; task2; "Множители и факториалы "}
{$M 60000,0,655360}
const nmax=150;
var mas: array[1..nmax] of longint;
n: integer;
procedure Init;
begin
assign(input, 'input.txt');
reset(input);
read(n);
close(input);
end;
procedure Solve;
var i, x, j: integer;
begin
for i:=2 to n do
begin
x:=i;
for j:=2 to x do
begin
while x mod j=0 do
begin
x:=x div j;
inc(mas[j]);
end;
end;
end;
end;
procedure Done;
var i: integer;
begin
assign(output, 'output.txt');
rewrite(output);
write(n, '! = ');
for i:=1 to nmax do
if mas[i]<>0 then
write(mas[i], ' ');
close(output);
end;
begin
Init;
Solve;
Done;
end.
2. Решение задачи «Горизонты для архитектора» ,
предложенное студентом 1 курса факультета ПММ ВГУ
Щербаковым Евгением
/* Scherbakov Evgenij VSU PMM 1k3gr*/
#include <iostream.h>
#include <fstream.h>
void main(){
int l[51],h[51],r[51],m,i,j,z[10001],flag,temp;
fstream f;
f.open("input.txt",ios::in);
m=0;
do { m++;
f>>l[m]>>h[m]>>r[m];
} while (!f.eof());
f.close();
for (i=1;i<=10000;i++) z[i]=0;
for (i=1;i<=m;i++) for (j=l[i];j<r[i];j++) if (z[j]<h[i]) z[j]=h[i];
f.open("output.txt",ios::out);
i=1; flag=0;
do {
temp=z[i];
j=i;
while (temp==z[j]) { j++; if (j==10000) { flag=1; break; }}
if (flag) {
for (i=10000;;i--) if (z[i]!=0) break;
f<<++i<<' '<<0;}
else f<<i<<' '<<z[j-1]<<' ';
i=j;
} while (!flag);
f.close();
}
3. Решение задачи «Автобусы» (первый тур, задача, общая
для всех номинаций), предложенное студентом 2 курса
факультета ПММ Скрипченковым Денисом
{ Скрипченков Денис Александрович.
ВГУ . Факультет ПММ. 2 курс. 5 группа.}
Program stop_avto;
type mas=array[1..3000]of shortint;
var
inp,outp:text;
k:mas;
n,e,i,d:integer;
a,b:array[1..300]of shortint;
{Процедура перевода данных из файла в массив}
Procedure priem(var f:text);
var
s,si:string;
ni,ier,l,i,j:integer;
begin
readln(f,s);
val(s,n,ier);
readln(f,s);
l:=length(s);
j:=0;
for i:=1 to l-1 do
if (s[i]>='0')and(s[i]<='9') then
if (s[i+1]>='0')and(s[i+1]<='9') then
begin
si:=copy(s,i,2);
val(si,ni,ier);
j:=j+1;
k[j]:=ni
end
else if ((s[i-1]<'0')or(s[i-1]>'9'))or(i=1) then
begin
si:=copy(s,i,1);
val(si,ni,ier);
j:=j+1;
k[j]:=ni
end;
end;{priem}
{Создание массивов для файла 'output.txt'}
Procedure osnovnaya;
var
i,i1,j,y,p,s,z:integer;
t1,f:boolean;
begin
e:=0;
for i:=1 to n-1 do
if k[i]<30 then
begin
f:=true;
t1:=false;
j:=i+1;
p:=k[i];
y:=k[j];
while f and (not t1) do
begin
t1:=true;
repeat
s:=0;
for i1:=j to n do
if k[i1]=y then s:=s+1;
if (s=0)or(k[i]=k[j])or(p>=k[j]-k[i])or((k[i]=k[i-1])and(k[j]-
k[i]<=b[e]))then t1:=false;
y:=y+k[j]-k[i]
until (not t1) or (y>59);
if (not t1) and (j>=n) then f:=false;
j:=j+1;
y:=k[j];
if t1 then
for z:=i to n do
if k[z]=k[i] then
begin
e:=e+1;
a[e]:=p;
b[e]:=k[j-1]-k[i];
end
end
end
end;{osnovnaya}
{Запись в выходной файл}
Procedure peredelka;
var
o1,o2,i,i1,j,t,s,s2:integer;
begin
for i:=1 to e-1 do
for j:=i+1 to e do
if (b[i]>b[j])or((b[i]=b[j])and(a[i]>a[j])) then
begin
o1:=b[i];
o2:=a[i];
b[i]:=b[j];
a[i]:=a[j];
b[j]:=o1;
a[j]:=o2
end;
end;{peredelka}
procedure provorot;
var
i,j,i1,t,s,s2,y:integer;
begin
for i:=1 to e do
begin
t:=a[i];
repeat
j:=1;
s:=0;
repeat
if k[j]=t then s:=1;
j:=j+1
until (s=1)or(j>n);
t:=t+b[i]
until (t>59)or(s=0);
if s=1 then
begin
t:=a[i];
s2:=120;
repeat
for i1:=1 to n do
if (k[i1]=t)and(k[i1]<>s2) then
begin
s2:=k[i1];
k[i1]:=120
end;
t:=t+b[i]
until t>59
end
else b[i]:=0
end;
t:=0;
for i:=1 to n do
if k[i]<>120 then
begin
t:=t+1;
k[t]:=k[i]
end;
n:=t;
y:=0;
for i:=1 to e do
if b[i]<>0 then
begin
y:=y+1;
a[y]:=a[i];
b[y]:=b[i]
end;
e:=y;
end;{provorot}
Procedure vivod(var f:text);
var
i:integer;
s1,s2,s:string;
begin
for i:=1 to e do
if b[i]<>0 then
begin
str(a[i],s1);
str(b[i],s2);
s:=s1+' '+s2;
writeln(f,s)
end
end;{vivod}
Begin
assign(inp,'input.txt');
reset(inp);
priem(inp);
assign(outp,'output.txt');
rewrite(outp);
d:=0;
repeat
d:=d+1;
osnovnaya;
peredelka;
provorot;
vivod(outp)
until (e=0)or(d>=17);
close(outp);
End.
4. Решение задачи «Лабиринт» (1 тур, основная
номинация), предложенное студентом 3 курса факультета
ПММ ВГУ Выростковым Дмитрием .
{ Первый тур школы - олимпиады ,
Секция программирования и информационного моделирования
Номинация информатика как профилирующая дисциплина
Задание № 2.
Выполнил Выростков Дмитрий Андреевич,
студент 3 курса ВГУ (г. Воронеж, Университетская площадь, 1),
факультета ПММ, специальноcть "Прикладная математика и
информатика",
специализация - "Математическое обеспечение ЭВМ
E-Mail: diman8@hotbox.ru}
uses crt, queue;
type
proom = ^room;
room = record
x, y : longint; {расположение комнаты }
lab : longint; {метка (для кратчайшего пути )}
pN, pE, pS, pW : proom; {указатели на соседнии комнаты }
prev : proom; {предыдущий элемент списка}
end;
var pFirst, pEnd : proom; {первая и последняя комныты }
pLast1, pLast2, pLast3, pLast4 : proom; {последние элементы списка}
nRooms : longint; {количество комнат}
procedure Error(ErrSt : string); {вывод ошибки }
begin
writeln(ErrSt);
write('Нажмите любую клавишу для выхода...');
readkey; halt(1);
end;
procedure AddRoom(var x, y : longint; c : char); {добавление новой
комнаты }
var p : proom;
ppl : ^proom;
begin
if (pEnd = nil) then begin {в случае создания самой первой комнаты }
new(pEnd); inc(nRooms);
pEnd^.x := x; pEnd^.y := y;
pEnd^.lab := -1;
pEnd^.prev := nil;
pEnd^.pN := nil; pEnd^.pE := nil; pEnd^.pS := nil; pEnd^.pW := nil;