Версия для печати темы
Форум «Всё о Паскале» _ Делфи _ Тест на логику (олимпиадные задачи)
Автор: ___ALex___ 12.01.2003 21:03
Народ, предложите своё решение...
1. Составить алгоритм заполнения прямоугольной таблицы размером N*N целыми числами от 1 до N*N по спирали. Пример для N=5.
Цитата
1 2 3 4 5
16 17 18 19 6
15 24 25 20 7
14 23 22 21 8
13 12 11 10 9
2. Переставить две части массива А из n элементов, первая часть - элементы с номерами от 1 до m, вторая - от m+1 до n. При этом порядок элементов в каждой из частей должен быть сохранен и нельзя использовать дополнительные массивы.
Пример. n=9, m=5
Вход: 9 4 7 2 3 5 8 1 6 Выход: 5 8 1 6 9 4 7 2 3
Автор: Ivs 13.01.2003 1:45
Спираль:
Код
program Spiral;
uses crt;
const h=6;
var
a:array[1..h,1..h] of integer;
i,j,n,k,b,z,m:integer;
begin
ClrScr;
n:=h;
m:=1;
z:=n;
k:=1;
i:=1;j:=1;
for b:=1 to z*z do
begin
for j:=m to n do
begin
a[i,j]:=k;
k:=k+1;
end;
k:=k-1;
for i:=m to n do
begin
a[i,j]:=k;
k:=k+1;
end;
k:=k-1;
for j:=n downto m do
begin
a[i,j]:=k;
k:=k+1;
end;
k:=k-1;
m:=m+1;
for i:=n downto m do
begin
a[i,j]:=k;
k:=k+1;
end;
n:=n-1;
end;
for i:=1 to z do
begin
for j:=1 to z do write(a[i,j]:5);
writeln;
end;
readln;
end.
Добавлено (12.01.03 21:12):Перестановка:
Код
const n=10;
var
i,j,x,m:integer;
a:array[1..n] of integer;
begin
ClrScr;
Randomize;
for i:=1 to n do
begin
a[i]:=random(9)+1;
write(a[i]:3);
end;
writeln;
write('input m-> ');readln(m);
for i:=1 to m do
begin
x:=a[1];
for j:=1 to n-1 do a[j]:=a[j+1];
a[n]:=x;
end;
for i:=1 to n do write(a[i]:3);
readln;
end.
Автор: ___ALex___ 14.01.2003 1:44
Ivs: спираль, но код покомпактней малость
Код
program Spiral;
var
Mas: Array[1..n, 1..n] of Integer;
i, x, g, e, s: Integer;
begin
g := 0;
e := n + 1;
s := 0;
x := 0;
repeat
Inc(s);
Inc(g);
Dec(e);
for i := g to e do begin Inc(x); Mas[s, i] := x; end;
for i := s + 1 to e do begin Inc(x); Mas[i, e] := x; end;
for i := e - 1 downto g do begin Inc(x); Mas[e, i] := x; end;
for i := e - 1 downto s + 1 do begin Inc(x); Mas[i, s] := x; end;
until x = Sqr(n);
WriteLn;
for i := 1 to n do begin
for x := 1 to n do Write(Mas[i, x]:5, ' ');
WriteLn;
end;
ReadLn
end.
Добавлено (13.01.03 20:58):Ivsа с обменом в массиве ты эмулировал сдвиг я понял. эта мысль мне в голову пришла первой, но никогда не задумывался об эффективности?! при таком подходе используется m * n перестановок! можно сделать за n! я сам ещё не доделал эту фишку (сессия фигова)
Удачи
Добавлено (14.01.03 22:42):IvsКод
program Perestanovka;
const
n = 9;
m = 8;
k = n - m;
var
A: Array[1..n] of Byte;
t1, t2: Byte;
i, nInd, Ind, cob: Integer;
begin
for i := 1 to n do begin A[i] := i; Write(A[i], ' '); end;
cob := 0;
nInd := cob;
if (m > 0) and (m <> n) then
if n mod m = 0 then
for i := 1 to m do
begin
Ind := i;
t2 := A[i];
repeat
t1 := t2;
if Ind <= m then Inc(Ind, k) else Dec(Ind, m);
t2 := A[Ind];
A[Ind] := t1;
until Ind = i;
end else
begin
repeat
Inc(nInd);
t2 := A[nInd];
Ind := nInd;
repeat
Inc(cob);
t1 := t2;
if Ind <= m then Inc(Ind, k) else Dec(Ind, m);
t2 := A[Ind];
A[Ind] := t1;
until (Ind = nInd) or (cob = n);
until cob = n;
end;
WriteLn;
for i := 1 to n do Write(A[i], ' ');
ReadLn
end.
Вот этот алгоритм выполняет требуемые действия за n перестановок твой же за m * n! Я прогнал на время (по 30000000 циклов) каждый алгоритм!
Вот результаты:
Брал пограничные значения m (то есть 1 и n - 1) и n = 9
При m = 1 твой алгоритм опережал мой на 2 секунды!( это из-за большего числа разных условий и дополнительных операций в моей реализации, следовательно если юзаешь только одиночные сдвиги, то твой предпочтительней потому что он проще и быстрее, но мой надо использовать при сдвигах больших единицы (для этой цели он собственно и кодился!!!) )
При m = 8 мой алгоритм опережал твой на 16 секунд! Вот такие дела! Кстати ты не знаешь как узнать дату последнего выключения компа???Очень надо!
Автор: Some1 2.02.2003 5:30
А вот ещё интересное решение спирали:
Для тех, кто не любит циклы for :)))))
Код
uses crt;
var
x1,y1,x2,y2,x,y:byte;
a:array[1..100,1..100] of integer;
val,dx,dy:integer;
n:byte;
begin
clrscr;
write('Введите N:');
readln(n);
x1:=1;
y1:=1;
x2:=n;
y2:=n;
val:=1;
dx:=1;
dy:=0;
x:=1;
y:=1;
repeat
a[x,y]:=val;
inc(val);
if not(x+dx in [x1..x2]) then
begin
dx:=0;
dy:=byte(x=x2)-byte(x=x1);
dec(x2,byte(x=x1));
inc(x1,byte((x=x2)and(x<>n)));
end;
if not(y+dy in [y1..y2]) then
begin
dy:=0;
dx:=byte(y=y1)-byte(y=y2);
dec(y2,byte(y=y1));
inc(y1,byte(y=y2));
end;
x:=x+dx;
y:=y+dy;
until (x1>=x2)and(y1>=y2);
for y:=1 to n do
begin
for x:=1 to n do write(a[x,y]:3);
writeln;
end;
end.
Получилось не очень компактно, но я думаю, как это оптимизировать :)
тю.. чё это у вас с тегом
code?.. чего он пробелы убивает (если их много)? А вот когда я отредактировал (ну вписал это) то всё встало на свои места.. глюкисы.. :<
Автор: mj 2.02.2003 6:01
Я эти задачки решал на олимпиадах, причём на решение и оформение каждой было всего по 10 минут...
Автор: Some1 2.02.2003 6:28
И ещё один вариант, похож на предыдущий, немного оптимизирован принцип:
Это для тех, кто не любит ещё и явно указывать условия ))))
Код
uses crt;
var
x1,y1,x2,y2,x,y:byte;
a:array[1..100,1..100] of integer;
val,dx,dy:integer;
n:byte;
begin
clrscr;
write('Введите N:');
readln(n);
x1:=1;
y1:=1;
x2:=n;
y2:=n;
val:=1;
x:=1;
y:=1;
repeat
a[x,y]:=val;
dx:=byte((y=y1)and(x<>x2))-byte((y=y2)and(x<>x1));
dy:=byte((x=x2)and(y<>y2))-byte((x=x1)and(y<>y1));
inc(x1,byte((dx=0)and(y=y1)and(val<>n)));
dec(x2,byte((dx=0)and(y=y2)));
inc(y1,byte((dy=0)and(x=x2)));
dec(y2,byte((dy=0)and(x=x1)and(val<>1)));
inc(x,dx);
inc(y,dy);
inc(val);
until val>n*n;
for y:=1 to n do
begin
for x:=1 to n do write(a[x,y]:3);
writeln;
end;
end.
Добавлено (2.02.03 1:32):Цитата
Я эти задачки решал на олимпиадах, причём на решение и оформение каждой было всего по 10 минут...
Представляю себе
)) если бы я решал на олимпиаде, я бы конечно не думал о "изящности" решения
)))
Прога может и не была бы оптимальной и маленькой, но я постарался бы уложиться в 10 минут, и думаю смог бы.. единственная проблемма у меня всегда была с оформлением. Что у вас под этим словом подразумевалось ?
З.Ы. И что, выиграл ?
))))
Автор: ___ALex___ 2.02.2003 16:12
Some1:
И какую же ты оптимизировал? ;D
Автор: Some1 3.02.2003 1:55
А как по твоему ?:)
Я просто старался избавиться от явных условий, и явных циклов :)
Ну просто ради интереса :)