Тест на логику (олимпиадные задачи) |
Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.
Тест на логику (олимпиадные задачи) |
___ALex___ |
12.01.2003 17:03
Сообщение
#1
|
Бывалый Группа: Пользователи Сообщений: 282 Репутация: 0 |
Народ, предложите своё решение...
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 |
12.01.2003 21:45
Сообщение
#2
|
Бывалый Группа: Пользователи Сообщений: 209 Репутация: 0 |
Спираль:
Код 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. -------------------- Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
|
___ALex___ |
13.01.2003 21:44
Сообщение
#3
|
Бывалый Группа: Пользователи Сообщений: 282 Репутация: 0 |
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 1:30
Сообщение
#4
|
Новичок Группа: Пользователи Сообщений: 38 Репутация: 0 |
А вот ещё интересное решение спирали:
Для тех, кто не любит циклы 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 2:01
Сообщение
#5
|
Adminь Группа: Администраторы Сообщений: 803 Пол: Мужской Реальное имя: Евгений Репутация: 5 |
Я эти задачки решал на олимпиадах, причём на решение и оформение каждой было всего по 10 минут...
|
Some1 |
2.02.2003 2:28
Сообщение
#6
|
Новичок Группа: Пользователи Сообщений: 38 Репутация: 0 |
И ещё один вариант, похож на предыдущий, немного оптимизирован принцип:
Это для тех, кто не любит ещё и явно указывать условия )))) Код 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 12:12
Сообщение
#7
|
Бывалый Группа: Пользователи Сообщений: 282 Репутация: 0 |
Some1:
И какую же ты оптимизировал? ;D |
Some1 |
2.02.2003 21:55
Сообщение
#8
|
Новичок Группа: Пользователи Сообщений: 38 Репутация: 0 |
А как по твоему ?:)
Я просто старался избавиться от явных условий, и явных циклов :) Ну просто ради интереса :) |
Текстовая версия | 21.09.2024 22:26 |