Среда, 08.01.2025
Pascal 4 All
[ · Новые сообщения · Участники · Правила форума · Поиск · RSS ]

 

  • Страница 1 из 1
  • 1
Модератор форума: Seqular, Pavel  

алгоритм обхода прямоугольного массива "змейкой
BlackMaggotДата: Четверг, 17.01.2008, 01:59 | Сообщение # 1
Новичок
Группа: Пользователи
Сообщений: 5
Репутация: 0
Замечания: 0%
Статус: Offline
Помоги мне пожалуйста решить задачу на эту тему.Цифры должны располагаться в таком порядке:

1 2 6
3 5 7
4 8 9

 
SeqularДата: Суббота, 19.01.2008, 10:29 | Сообщение # 2
Хранитель
Группа: Администраторы
Сообщений: 859
Репутация: 35
Статус: Offline
Попробуй таким кодом.. Кое-где можно оптимизировать, если нужно...

Code
Program Snake;
Uses CRT;
Const m = 4;
Var Count: Integer;
     i: Byte;
     ii: Byte;
     a: Array[1..m, 1..m] of Integer;

Procedure Print;
Var j, jj: Byte;
Begin
ClrScr;
For j := 1 to m do
     Begin
     For jj := 1 to m do
         Write(a[j,jj]:3);
     Writeln;
     End;
ReadKey;
End;

Begin
ClrScr;
Count := 1;
i := 1;
a[1,1] := 1;
Print;
While (Count <> m * m) do
       Begin
       Inc(i);
       If (i <= m) then
       If (Odd(i)) then For ii := i downto 1 do
                            Begin
                            Inc(Count);
                            a[ii,i-ii+1] := Count;
                            Print;
                            End
                   else For ii := i downto 1 do
                            Begin
                            Inc(Count);
                            a[i-ii+1,ii] := Count;
                            Print;
                            End
       else
       If (not Odd(i)) then For ii := i-m+1 to m do
                            Begin
                            Inc(Count);
                            a[ii,m-ii+(i-m+1)] := Count;
                            Print;
                            End
                   else For ii := i-m+1 to m do
                            Begin
                            Inc(Count);
                            a[m-ii+(i-m+1),ii] := Count;
                            Print;
                            End;
       End;
End.

Проверка:
Для 4-х:

Для 7-ми:

Если что-то не будет работать - пиши.... пересмотрю

Прикрепления: 7025963.gif (2.5 Kb) · 4417511.gif (4.0 Kb)


Поддерживаю также проект сообщество молодых сисадминов
 
  • Страница 1 из 1
  • 1
Поиск:

Copyright MyCorp © 2025
Используются технологии uCoz
javascript:;" rel="nofollow" onclick="loginPopupForm(); return false;