IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Заполнение массива по спирали
Alexdel
сообщение 10.02.2010 11:17
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской
Реальное имя: Алексей

Репутация: -  0  +


Всем привет! требуется написать прогу для заполнения прямоугольной таблицы размерами n*n по спирали числами от 1 до n*n. Я вот тут кое-что написал но работает не так, как надо... Мозги уже кипят... Помогите плиз кто чем может... Хотя бы намёк сделайте=)


Прикрепленные файлы
Прикрепленный файл  1.pas ( 506 байт ) Кол-во скачиваний: 461
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
RathaR
сообщение 10.02.2010 15:29
Сообщение #2


Знаток
****

Группа: Пользователи
Сообщений: 346
Пол: Мужской
Реальное имя: Иван

Репутация: -  7  +


Забавно smile.gif
Буквально вчера, сидел в кабинете информатики, пересматривал задания старых олимпиад, и наткнулся на первую(!) олимпиаду по программированию, что проводились у нас, год точно не скажу, девяносто какой то, так это была первая задача в той олимпиаде))) Просто ради интереса сел, сделал её, за урок, правда там матрица прямоугольная была.
Вот, собственно, мое решение, особо долго не думал над ней(просто обходил матрицу определяя куда ставить след номер)...

const
max_size=10;

type
tMove=(up,down,left,right);
var
m,n:integer;
A:array[0..max_size+1,0..max_size] of integer;
I:integer;
K:integer;
x,y:integer;

procedure Input(var x,y:integer);
var
F1:text;
begin
assign(F1,'spiral.dat');
reset(F1);
read(F1,N,M);
close(F1);
end;

procedure Output;
var
I,J:integer;
F2:text;
begin
assign(F2,'spiral.sol');
rewrite(F2);
for I:=0 to m+1 do
begin
for J:=0 to n+1 do
write(F2,A[I,J]:3);
writeln(F2);
end;
close(F2);
end;
function move(x,y:integer):tMove;
var
left_z,right_z,up_z,down_z:boolean;
begin
if A[x+1,y]=0 then right_z:=true else right_z:=false;
if A[x-1,y]=0 then left_z:=true else left_z:=false;
if A[x,y+1]=0 then down_z:=true else down_z:=false;
if A[x,y-1]=0 then up_z:=true else up_z:=false;
if right_z and not down_z then move:=right;
if left_z and not up_z then move:=left;
if up_z and not right_z then move:=up;
if down_z and not left_z then move:=down;
end;

begin
Input(m,n);
fillchar(A,sizeof(A),0);
for I:=0 to N+1 do
begin
A[0,I]:=-1;
A[M+1,I]:=-1;
end;
for I:=0 to M+1 do
begin
A[I,0]:=-1;
A[I,N+1]:=-1;
end;

K:=1;
x:=m;
y:=1;
A[x,y]:=K;
while K<>m*n do
begin
case move(x,y) of
right:begin
inc(K);
inc(x);
A[x,y]:=K;
end;
left:begin
inc(K);
dec(x);
A[x,y]:=K;
end;
up:begin
inc(K);
dec(y);
A[x,y]:=K;
end;
down:begin
inc(K);
inc(y);
A[x,y]:=K;
end; end;
end;
Output;
end.

Заядло я её не тестировал, но вроде работает, файлы прикрепляю.

Сообщение отредактировано: RathaR - 10.02.2010 15:34


Прикрепленные файлы
Прикрепленный файл  spiral.rar ( 906 байт ) Кол-во скачиваний: 364


--------------------
Считающий себя единственым здравомыслящим человеком сумасшедший? Если да, возможно я псих...
Пусть умолкнет всякий критик!
Я - системный аналитик!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Alexdel   Заполнение массива по спирали   10.02.2010 11:17
Lapp   требуется написать прогу для заполнения прямоуголь...   10.02.2010 11:52
Lapp   Мозги уже кипят... Помогите плиз кто чем может... ...   10.02.2010 12:29
RathaR   Забавно :) Буквально вчера, сидел в кабинете инфо...   10.02.2010 15:29
Lapp   сел, сделал её, за урок, правда там матрица прямоу...   11.02.2010 3:20
Lapp   На свежую голову (после работы)) глянул на код и з...   11.02.2010 10:49
RathaR   Мне эта задача выпала на лабораторную по проге, за...   20.10.2010 17:48
RathaR   Сегодня эта задача попалась на тренировке по спорт...   2.11.2010 22:31
Lapp   задача классическая, никто не споритЯ спорю. Ни р...   3.11.2010 0:44
Unconnected   Это уже правда судьба )) А на каких тестах, не по...   2.11.2010 23:02
TarasBer   > А на каких тестах, не показывается там? Ну д...   2.11.2010 23:04
Unconnected   Оой ну прям такое неуважение, набросок тестирова...   3.11.2010 0:55
Lapp   Оой ну прям такое неуважение, набросок тестировать...   3.11.2010 1:48


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.07.2025 21:38
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"