На форумі обговорюються лише питання, пов'язані з олімпіадою
Ви не зайшли.
Предлагаю выкладывать интересные чем то решения. Например самые короткие решения. Естественно решения должны быть АС
PS: Задачи легкие так что давайте у кого так сказать короче )) или лаконичнее.
Відредаговано necro (2007-11-07 16:30:22)
Поза форумом
Начну сам ) :
_____________________________________________________
Snake :
var
x, y : longint;
begin
readln(x, y);
writeln(abs(2 * (ord(abs(x) <= abs(y)) * x + ord(abs(x) > abs(y)) * y)) + 2 * abs(abs(x) - abs(y)) - ord(odd(abs(x - y))));
end.
_____________________________________________________
Поза форумом
program snake;
var x,y:integer;
begin
read(x,y);
x:=abs(x);
y:=abs(y);
if x>y
then writeln(2*x-((x-y) mod 2))
else writeln(2*y-((y-x) mod 2))
end.
Поза форумом
Cris написав:
program snake;
var x,y:integer;
begin
read(x,y);
x:=abs(x);
y:=abs(y);
if x>y
then writeln(2*x-((x-y) mod 2))
else writeln(2*y-((y-x) mod 2))
end.
Не спорю что куда лаконичнее но я написал в две строки и этим я хотел зарулить )).
У когото есть более коротике решения типа readln-writeln?
Поза форумом
можете разказать слгоритм Gears я так понял что бы найти минимальное количество синих шустеренок
то я упорядочивал масив состоящий из радиусов красных колес и потом проходил масив проверяя:
если они одного размера то надо 1 колесо еси разных размеров то 2
но увы почемуто оно тест непрошло полностью
Поза форумом
Gears :
var
a : array [1..10000] of boolean;
ans, i, n, k : longint;
begin
read(n);
ans := -2;
for i := 1 to n do begin
read(k);
ans := ans + 1 + ord(not a[k]);
a[k] := true;
end;
writeln(ans);
end.
Поза форумом
а разказать?
и сколько эта задача набрала балов?
Відредаговано Cris (2007-11-07 17:47:07)
Поза форумом
Cris написав:
можете разказать слгоритм Gears я так понял что бы найти минимальное количество синих шустеренок
то я упорядочивал масив состоящий из радиусов красных колес и потом проходил масив проверяя:
если они одного размера то надо 1 колесо еси разных размеров то 2
но увы почемуто оно тест непрошло полностью
Ну по сути идея у тебя верная : упорядочиваем массив, так как если колеса одного радиуса рядом, то нужна одна шестеранка иначе - две. Я использовал линейную сортировку (точнее ее идею) так как тип входных данных меньше интежера.
Поза форумом
program gears;
var k,a,i,c,s:longint;
b:array[1..10000] of integer;
begin
read(a);
for i:=1 to a do
read(b[i]);
while k=0 do
begin
k:=1;
for i:=1 to a-1 do
if b[i]>b[i+1]
then begin
c:=b[i];
b[i]:=b[i+1];
b[i+1]:=c;
k:=0;
end;
end;
for i:=1 to a-1 do
if b[i]=b[i+1]
then inc(s)
else inc(s,2);
write(s);
end.
Поза форумом
Cris написав:
а разказать?
и сколько эта задача набрала балов?
полный бал. Неполные решения непубикуют обычно - разве что чтото хитрое.
Поза форумом
Cris написав:
program gears;
var k,a,i,c,s:longint;
b:array[1..10000] of integer;
begin
read(a);
for i:=1 to a do
read(b[i]);
while k=0 do
begin
k:=1;
for i:=1 to a-1 do
if b[i]>b[i+1]
then begin
c:=b[i];
b[i]:=b[i+1];
b[i+1]:=c;
k:=0;
end;
end;
for i:=1 to a-1 do
if b[i]=b[i+1]
then inc(s)
else inc(s,2);
write(s);
end.
Это слишком сложно по времени. Нужно было сортировать хотябы квиксортом тогда 20 из 20 взял бы. А так сколько?
Поза форумом
Более подробно мое решение пояснить или все ясно уже?
Поза форумом
обьясни
и вот мой кайф:
program kife;
var n,i,j:byte;
g:char;
l,max,ls:string;
begin
readln(n,g,l);
ls:=l;
for j:=1 to n do
begin
max:='';
for i:=1 to length(l) do
begin
delete(l,i,1);
if max<l
then max:=l;
l:=ls;
end;
l:=max;
ls:=l;
end;
write(max);
end.
Поза форумом
разкажи как ты делал милитари, ато я делал самым простым и тупым способом проходил масив и менял де надо > на < и< на>
Поза форумом
еси у тя сегмент весь полностью пашет то выложи его код хочю посотреть
и еше про милитари: ты нашол такую комбинацию при какой марш начать невозможно?
Поза форумом
кста а нельзя ли получить какие были тесты??
на разные задачи или же авторские прогрыма?
Поза форумом
Cris написав:
еси у тя сегмент весь полностью пашет то выложи его код хочю посотреть
и еше про милитари: ты нашол такую комбинацию при какой марш начать невозможно?
Segment :
{$APPTYPE CONSOLE}
var
i, n, pk, k, l, al, ar, ans, sum : longint;
begin
read(n);
l := 1; sum := 0; ans := -maxlongint; pk := -maxlongint;
for i := 1 to n do begin
read(k);
if (k = pk + 1) and (k > 0) then sum := sum + k
else begin sum := k; l := i; end;
if ((sum > ans) and (sum <> 0)) then begin
ans := sum; al := l; ar := i;
end;
pk := k;
end;
writeln(al, ' ', ar, ' ', ans);
end.
Military : Алогритм придумвал сам и вывел что марш можно закончить всегда. Основная придумка такая что солдаты поворачиваясь просто меняются местами - проходят друг сквозь друга.
Количетво общее шагов считал так : для кажого солдата смотрящего вправо считаем сколько справа от него тех кто смотрит влево и по всем солдатам это сумируем (так как через каждого такого солдата ему надо будет пройти). А про время там долго обьяснять придумай уж сам - там по тому же принципу.
Відредаговано necro (2007-11-07 18:50:10)
Поза форумом
Cris написав:
кста а нельзя ли получить какие были тесты??
на разные задачи или же авторские прогрыма?
Пожжей - после олимпы (всех 4 туров) обычно вывешивают архив олимпы. А пока что можеш писать решения и сдавать в онлайне уже на полном наборе тестов.
Поза форумом
Cris написав:
обьясни
По задаче Геарс :
Смотри ответ будет состоять из сумы двух частей :
1. N-1 - между каждой парой соседних колес.
2. +1 на каждый переход между колесами разного радиуса.
По сути мы можем минимизировать только вторую часть минимальное количество соседних колес с разными радиусами будет тогда когда их сгрупировать по радиусам (все с одинаковыми радиусами ставить рядом) - в часности это дает сортировка. То есть вторая часть равна количесву разных радиусов минус один.
И так мой масив булеанов :
a[i] boolean - определяет встречался ли нам уже такой радиус в цикле идем (в моей проге) если не встречался то +1 к счетчику. и Заночим в a[i] = true;
Изначально а[i] = false для всех i
Відредаговано necro (2007-11-07 19:06:43)
Поза форумом
Cris написав:
обьясни
и вот мой кайф:
program kife;
var n,i,j:byte;
g:char;
l,max,ls:string;
begin
readln(n,g,l);
ls:=l;
for j:=1 to n do
begin
max:='';
for i:=1 to length(l) do
begin
delete(l,i,1);
if max<l
then max:=l;
l:=ls;
end;
l:=max;
ls:=l;
end;
write(max);
end.
Мой кайф по легче но задумка то проста остальное дело техники:
var
s : string;
ch : char;
q, i, j, k, p : longint;
begin
read(p);
readln(ch, s);
q := length(s) - p;
k := 1;
for i := 1 to length(s) - p do begin
for j := k to length(s) - q + 1 do if (s[k] < s[j]) then k := j;
write(s[k]);
dec(q); inc(k);
end;
end.
Поза форумом
спс, все понял
Поза форумом
Military:
#include <stdio.h> int sum,max; void ReadNSolve () { sum = max = 0; int i = 0; int curleft = 0; int delay = 0; int moves; char c; scanf ("%c",&c); while ((c == '>') || (c == '<')) { if (c == '<') { moves = (i-curleft); sum += moves; if (moves > 0) { if (moves + delay > max) max = moves + delay; delay++; } curleft++; } else { if (delay > 0) delay--; } i++; scanf ("%c",&c); } } void WriteData () { printf ("%d %d\n",max,sum); } int main () { // freopen ("military4.dat","r",stdin); // freopen ("military4.sol","w",stdout); ReadNSolve (); WriteData (); return 0; }
Надеюсь, алгоритм будет несложно понять - старался писать чисто.
Поза форумом
Думаю, интересными здесь покажутся 2 решения - Геарс и Милитари. Снейк не выкладываю - это банально, Сегмент такой же, как и у всех (да и алгоритм красивым не назвать по виду, впрочем, какая разница - всё равно AС), а Кайф - единственный из всех задач - недобрал 5 баллов.
Military4
program Military4; {$APPTYPE CONSOLE} type integer=longint; var pc, c: char; qr, time, quan: Integer; function max(a,b: integer): Integer; begin if a>b then max:=a else max:=b end; begin repeat Read(c) until (c='>') or eoln; qr:=1; time:=0; quan:=0; pc:=c; while not eoln do begin Read(c); if c='>' then Inc(qr) else begin Inc(quan,qr); if pc='>' then time:=max(qr,time+1) else inc(time) end; pc:=c; end; Writeln(time,' ',quan); end.
Gears
program Gears; {$APPTYPE CONSOLE} var count:array [1..10000] of integer; N,i,K,max:integer; begin Read(N); max:=0; for i := 1 to N do begin read(k); inc(count[k]); if k>max then max:=k; end; i:=1; while (i<=max) and (count[i]=0) do inc(i); K:=count[i]-1; inc(i); while i<=max do begin if count[i]>0 then inc(K,count[i]+1); inc(i); end; Writeln(K); end.
Відредаговано Skiminok (2007-11-07 22:54:20)
Поза форумом
Почему же Снейк елементарная. Простая - да но реализация то разной длинны бывает вот мой Readln Writeln я уже выкладывал, но может кто по короче смог? Понятно что за чудоалогритмами тут фактически нечего гнатся.
ПС : Имхо мой Гиарс покруче ))
var a : array [1..10000] of boolean; ans, i, n, k : longint; begin read(n); ans := -2; for i := 1 to n do begin read(k); ans := ans + 1 + ord(not a[k]); a[k] := true; end; writeln(ans); end.
Поза форумом
Интересно, а есть ли у кого-нибудь безмассивный Кайф?
Поза форумом