Помощь - Поиск - Пользователи - Календарь
Полная версия: Тест на логику (олимпиадные задачи)
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
___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
И ещё один вариант, похож на предыдущий, немного оптимизирован принцип:
Это для тех, кто не любит ещё и явно указывать условия smile.gif))))
Код
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 минут...

Представляю себе smile.gif)) если бы я решал на олимпиаде, я бы конечно не думал о "изящности" решения smile.gif)))
Прога может и не была бы оптимальной и маленькой, но я постарался бы уложиться в 10 минут, и думаю смог бы.. единственная проблемма у меня всегда была с оформлением. Что у вас под этим словом подразумевалось ?
З.Ы. И что, выиграл ? smile.gif))))
___ALex___
2.02.2003 16:12
Some1:
И какую же ты оптимизировал? ;D
Some1
3.02.2003 1:55
А как по твоему ?:)
Я просто старался избавиться от явных условий, и явных циклов :)
Ну просто ради интереса :)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.