Сейчас на форуме: rmn (+6 невидимых)

 eXeL@B —› Оффтоп —› Паскаль задачка. застрял на полуслове...
Посл.ответ Сообщение


Ранг: 156.2 (ветеран), 2thx
Активность: 0.09↘0
Статус: Участник

 Создано: 06 января 2009 01:02
· Личное сообщение · #1

Что-то я застрял на решении детской олимпиадной задачки. вот условие.
Составить программу ввода квадратной матрицы и печати в строку всех ее элементов в заданном ниже порядке следования.


На этой картинке исходная марица показана черным цветом. Цифры идут по возрастанию, отсюда понимаю, что обход по диагональной змейке - как показано на рисунке справа.
Я что-то пытался сделать на бумаге, но сделал не совсем то. сделал то, что показано на нижнем рисунке.
Привожу свой код. Он не оптимизирован.
Вряд ли его можно исправить под нужный обход. Я целый день уже думаю...

Code:
  2. program Project2;
  4. {$APPTYPE CONSOLE}
  6. var
  7. a,b,k,n,i,j:integer;
  8. inf, sub:integer;
  9. m:array[1..4, 1..4] of integer;
  10. begin
  11. n:=4;
  13. m[1,1]:=1;
  14. m[1,2]:=2;
  15. m[1,3]:=3;
  16. m[1,4]:=4;
  18. m[2,1]:=5;
  19. m[2,2]:=6;
  20. m[2,3]:=7;
  21. m[2,4]:=8;
  23. m[3,1]:=9;
  24. m[3,2]:=10;
  25. m[3,3]:=11;
  26. m[3,4]:=12;
  28. m[4,1]:=13;
  29. m[4,2]:=14;
  30. m[4,3]:=15;
  31. m[4,4]:=16;
  34. FOR K:=2 to 2*N do
  35. BEGIN
  36. writeln;
  38. if k mod 2=0 then
  39. begin
  40. inf:=k-1;
  41. sub:=1;
  42. if k>n+1 then
  43.  begin
  44.   inf:=n;
  45.   sub:=k-n;
  46.  end;
  47. writeln('k=',k);
  48.  for i:=inf downto sub do
  49.  for j:= sub to inf do
  50.   if i+j=k then write(' ',m[i,j],' ');
  51. end;
  53. if k mod 2=1 then
  54. begin
  55. inf:=1;
  56. sub:=k-1;
  57. if k>n+1 then
  58.  begin
  59.   inf:=k-n;
  60.   sub:=n;
  61.  end;
  62. writeln('k=',k);
  63.  for i:=inf to sub do
  64.  for j:=inf to sub do
  65.    if i+j=k then write(' ',m[i,j],' ');
  66. end;
  68. END;
  69. readln;
  70. end.





Ранг: 1288.1 (!!!!), 273thx
Активность: 1.29↘0
Статус: Участник

 Создано: 06 января 2009 02:05
· Личное сообщение · #2

исходная матрица на рисунке не совпадает с матрицей в коде...




Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 06 января 2009 03:27 · Поправил: Isaev
· Личное сообщение · #3

[del]

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 156.2 (ветеран), 2thx
Активность: 0.09↘0
Статус: Участник

 Создано: 06 января 2009 03:30
· Личное сообщение · #4

Ara
не совпадает, правильно! в коде я заполнил матрицу произвольными числами (для простоты в порядке возрастания). но вывел на консоль уже в порядке змейки!
На рисунке показано начало и направление обхода. Алгоритм у меня для нижнего рисунка, а не для правого

Isaev
щас гляну




Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 06 января 2009 03:36 · Поправил: Isaev
· Личное сообщение · #5

Вот такое вот совсем не олимпиадное решение детской олимпиадной задачки...
Зато для любого размера матрицы, хотя тебе это и не надо
на Delphi, хотя надо на паскале... Но работает!

А ещё я очень расстроен, т.к. это был именно тот нечестый вечер, когда я хотел по-раньше лечь поспать и наконец выспаться...
Ну не ПЕРЕД СНОМ нужно кричать помогите, сегодня сдавать!
Короче, Mavlyudov, с тебя подарок

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 06 января 2009 03:39
· Личное сообщение · #6

Лови

b3ce_05.01.2009_CRACKLAB.rU.tgz - Matrix.rar

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 156.2 (ветеран), 2thx
Активность: 0.09↘0
Статус: Участник

 Создано: 11 января 2009 22:41
· Личное сообщение · #7

Isaev
Так, так...интересно, но очень сложно и немного не то.
Мне нужно для консольного режима. Свой код для матрицы на нижнем рисунке я привел...
Вчера набросал кое-что на бумаге. Но не могу скомпоновать в программу, чтобы в ней
были вложенные циклы FOR(и не было процедур и циклов while). Очень прошу помощи.

Выкладываю свои записи ниже.
Оформляю так, как ц меня на бумаге.
ЗАпись "ПРоверка1--->a[4,2]" означает, что после проверки значение a[i,j] стало равным a[4,2].
(т.е. перешлди с предыдущего элемента на a[4,2]).

Для матрица 4 на 4.


-------------ПРОВЕРКА-1-------------------
if (i=4) or (i=1) then j:=j+1;
if (j=1) or (j=4) and (i<>4) then i:=i-1;
-----------END OF ПРОВЕРКА-1--------------


------------ПРОВЕРКА-2---------------------
if K mod 2=0 then
begin
i:=i-1;
j:=j-1;
end;

if K mod 2=1 then
begin
i:=i+1;
j:=j+1;
end;
---------END OF ПРОВЕРКА-2-----------------

//============================================

НАЧАЛО ПРОГРАММЫ
K:=3;
i:=4;
j:=1;

ПРОВЕРКА1 ---> K=2; A[4,2];
ПРОВЕРКА2 ---> K=1; A[3,1];
ПРОВЕРКА1 ---> K=1; A[2,1];
ПРОВЕРКА2 ---> K=1; A[3,2];
ПРОВЕРКА1 ---> K=1; A[4,3];
ПРОВЕРКА1 ---> K=0; A[4,4];
ПРОВЕРКА2 ---> K=0; A[3,3];
ПРОВЕРКА2 ---> K=0; A[2,2];
ПРОВЕРКА2 ---> K=0; A[1,1];
ПРОВЕРКА1 ---> K=-1; A[1,2];
ПРОВЕРКА2 ---> K=-1; A[2,3];
ПРОВЕРКА2 ---> K=-1; A[3,4];
ПРОВЕРКА1 ---> K=-2; A[2,4];
ПРОВЕРКА2 ---> K=-2; A[1,3];
ПРОВЕРКА1 ---> K=-3; A[1,4];

Вот всё, что получилось((((




Ранг: 355.4 (мудрец), 55thx
Активность: 0.32↘0
Статус: Uploader
5KRT

 Создано: 12 января 2009 02:09 · Поправил: coderess
· Личное сообщение · #8

Из объяснений ничего не понял, исправлять чужую труднее для меня чем самому заново написать, по-этому, как будет время попробую решить (для себя конечно же)

-----
Gutta cavat lapidem. Feci, quod potui. Faciant meliora potentes

Ранг: 36.1 (посетитель)
Активность: 0.01↘0
Статус: Участник

 Создано: 12 января 2009 13:09
· Личное сообщение · #9

На вскидку вышло вот так.
Code:
  1. uses crt;
  2. const x=4; y=4;
  3. var n:array[1..x,1..y] of integer;
  4. f,i,j:integer;
  5. qq,ww,q,w,p:integer;
  6. begin
  7. clrscr;
  8. for f:=1 to 2 do begin
  9. q:=1; w:=y; p:=1; qq:=1; ww:=1;
  10. repeat
  11. if f=1 then n[q,w]:=p else write (n[q,y-w+1]:3);
  12. inc(p);
  13. q:=q+qq;
  14. w:=w+ww;
  15. if (q<1) and (w<1) then begin q:=2; w:=1; qq:=1; ww:=1; end else begin
  16. if (q>x) and (w>y) then begin q:=x; w:=y-1; qq:=-1; ww:=-1; end else begin
  17. if q<1 then begin q:=1; qq:=qq*-1; ww:=ww*-1; end;
  18. if q>x then begin q:=x; qq:=qq*-1; ww:=ww*-1; w:=w+ww+ww; end;
  19. if w<1 then begin w:=1; q:=q-qq-qq; qq:=qq*-1;ww:=ww*-1; end;
  20. if w>y then begin w:=y; ww:=ww*-1;qq:=qq*-1; end;
  21. end;
  22. end;
  23. until p=(x*y);
  24. if f=1 then begin
  25. n[x,1]:=p;
  26. for i:=1 to x do begin
  27. for j:=1 to y do
  28. write (n[j,i]:3); writeln; end
  29. end
  30.  else write(n[q,y-w+1]:3);
  31. writeln;
  32. end;
  33. readln;
  34. end.

Наверняка можно покрасивее и свернуть условия покороче.. Но, в принципе, и на бОльших матрицах работает


 eXeL@B —› Оффтоп —› Паскаль задачка. застрял на полуслове...

У вас должно быть 20 пунктов ранга, чтобы оставлять сообщения в этом подфоруме, но у вас только 0

   Для печати Для печати