Форум: "Потрепаться";
Текущий архив: 2003.01.09;
Скачать: [xml.tar.bz2];

Вниз

Задачка   Найти похожие ветки 

← →
Grifon   (2002-12-18 21:54) [0]

Подскажите как решить задачу по информатике.
Требуется заполнить матрицу последовательными числами по спирали.

Примерно так:
1 16 15 14 13
2 17 24 23 12
3 18 25 22 11
4 19 20 21 10
5 6 7 8 9

Причем сторона матрицы различная.

Может кто поможет на паскале ее решить?

---

← →
MBo   (2002-12-19 06:31) [1]

возможный принцип:

var matr:array[n,m]
a:array[n*m]

xstep:=0;
ystep:=1;

x:=1;
y:=1;
k:=1;
xmax:=n
ymax:=m

repeat
matr[y,x]:=a[k]
inc(k);
x:=x+xstep;
y:=y+ystep;
if x>=xmax then begin
xstep:=0;
ystep:=1;
end;
//и т.п. условия, с учетом направления (шаг по x и y будет 1,0,-1,0,1,0,-1 и т.д)

until k>n*m;

---

← →
MBo   (2002-12-19 09:23) [2]


procedure TForm1.Button1Click(Sender: TObject);
const
nx = 5;
ny = 5;
var
ix, iy, n, j, xstep, ystep, xlast, ylast, xa, xb, ya, yb, turn: integer;
matr: array[1..ny, 1..nx] of integer;
s: string;
begin
fillchar(matr, sizeof(matr), 0);
n := nx * ny;
ix := 1;
iy := 0;
turn := -1;
xa := nx + 1;
xb := 1;
ya := ny + 1;
yb := 0;
xlast := 1;
ylast := 0;
for j := 1 to n do
begin
if (iy = ylast) or (ix = xlast) then
begin
inc(turn);
case (turn mod 4) of
0:
begin
xstep := 0;
ystep := 1;
dec(ya);
xlast := xa;
ylast := ya;
end;
1:
begin
xstep := 1;
ystep := 0;
dec(xa);
ylast := yb;
xlast := xa;
end;
2:
begin
xstep := 0;
ystep := -1;
inc(yb);
xlast := xb;
ylast := yb
end;
3:
begin
xstep := -1;
ystep := 0;
inc(xb);
ylast := ya;
xlast := xb;
end;
end; //case
end; //if
ix := ix + xstep;
iy := iy + ystep;
matr[iy, ix] := j;
end; //for
for iy := 1 to ny do
begin
s := "";
for ix := 1 to nx do
s := s + format("%4d", [matr[iy, ix]]);
memo1.lines.add(s);
end;
end;


---

← →
Sha   (2002-12-19 11:04) [3]

А ты, парень, откуда? Лет пять назад решал я такую задачу.

---

← →
LongIsland   (2002-12-19 11:09) [4]

> Sha © (19.12.02 11:04)
> А ты, парень, откуда? Лет пять назад решал я такую задачу.

У нас в школе тоже такая задача была... На экзамене по информатике:-)

---

← →
Sha   (2002-12-19 11:12) [5]

Жаль, надеялся однокашника найти...

---

← →
Grifon   (2002-12-19 13:55) [6]

Вот что у меня получилось.

{$S+}
{$R+}
uses crt;

const
n = 10; {Сторона матрицы}

var i, x, y, nap: integer;
a: array[1..n, 1..n] of integer;

procedure creat;
var j, k: integer;
begin
for j := 1 to n do
for k := 1 to n do
a[j, k] := 0;
end;

procedure rsl;
var j, k: integer;
begin
for j := 1 to n do
begin
writeln;
for k := 1 to n do
write(a[j, k]:2, " ");
end;
while not keypressed do ;
end;

procedure nxt(var x, y, nap: integer);
begin
case nap of
1: if ((x+1)<(n+1)) and (a[x+1, y] = 0) then inc(x)
else begin
nap := 2;
nxt(x, y, nap);
end;
2: if ((y+1)<(n+1)) and (a[x, y+1] = 0) then inc(y)
else begin
nap := 3;
nxt(x, y, nap);
end;
3: if (x-1 > 0) and (a[x - 1, y] = 0) then dec(x)
else begin
nap := 4;
nxt(x, y, nap);
end;
4: if (y-1 > 0) and (a[x, y - 1] = 0) then dec(y)
else begin
nap := 1;
nxt(x, y, nap);
end;
end;{case}
end;

begin
clrscr;
creat;
nap := 1;
x := 1; y := 1;
for i := 1 to sqr(n) do
begin
a[x, y] := i;
if i = sqr(n) then begin rsl; exit; end;
nxt(x, y, nap);
end;
end.

---

← →
grifon   (2002-12-19 14:03) [7]

Тут программа заполняет всю матрицу нулями, затем начитает покругу ее заполнять. При этом заполненой может быть только ячейка со значением "0".


> LongIsland © (19.12.02 11:09)

По информатике училка дала, говоритт что не решу. Я вчера до часу ночи возился но решил!


> Sha ©

Из Волгодонска


> MBo ©

В первом совете не понял для чего массив "a"? Ведь можно просто в цикле прогнать.

---

← →
MBo   (2002-12-19 14:14) [8]

>grifon
Я исправился ;)
Кстати, для квадратной матрицы можно значительно упростить.

---

← →
Sha   (2002-12-20 08:45) [9]

2 grifon
> Из Волгодонска
Тоже хороший город.

2 MBo
У меня было длиннее. :)
Там, правда, есть, что обрезать. И не знаю даже, все еще работает, или уже кап-ремонт нужен. Давно не пользовался :))))))))

unit Spirals;
interface
function SpiralInit(SizeX, SizeY, Corner, DeltaDir, Rolling: integer): boolean;
function SpiralGet(var X, Y: integer): boolean;

implementation
const
DeltaX: array[0..3] of integer= (1,0,-1,0); {горизонтальный шаг по напр.}
DeltaY: array[0..3] of integer= (0,1,0,-1); {вертикальный шаг по напр.}
Rest : longint= 0; {всего осталось элементов}
var
CurX : integer; {текущая горизонтальная коор.}
CurY : integer; {текущая вертикальная коор.}
Roll : integer; {копия Rolling}
DDir : integer; {копия DeltaDir}
CurDir: integer; {текущее направление}
SizeXY: array[0..1] of integer; {остаточные размеры}
No : integer; {остаток по направлению}

function SpiralInit(SizeX, SizeY, Corner, DeltaDir, Rolling: integer): boolean;
var
StartX : array[0..3] of integer; {координаты углов}
StartY : array[0..3] of integer; {координаты углов}

begin;
{будем обходить матрицу [0..SizeY-1,0..SizeX-1] из угла Corner в направ-}
{лении DeltaDir по спирали к центру, или в обратном, если Rolling=-1}
{Corner =0..3 левый верний, правый верхний, правый нижний, левый нижний}
{DeltaDir=1/-1 по часовой / против}
{Rolling =1/-1 свернуть / развернуть}

Rest:=0;
if (SizeX<1) or (SizeY<1) or (Corner<0) or (Corner>3)
or (abs(DeltaDir)<>1) or (abs(Rolling)<>1) then begin;
SpiralInit:=false; exit;
end;

StartX[0]:=0; StartY[0]:=0; SizeXY[0]:=SizeX;
StartX[1]:=SizeX-1; StartY[1]:=0; SizeXY[1]:=SizeY;
StartX[2]:=SizeX-1; StartY[2]:=SizeY-1;
StartX[3]:=0; StartY[3]:=SizeY-1;

Rest:=SizeX*SizeY;
CurX:=StartX[Corner];
CurY:=StartY[Corner];
Roll:=1;
DDir:=DeltaDir;
CurDir:=(Corner+(1-DeltaDir) shr 1) and 3;
No:=SizeXY[CurDir and 1]-1;

if Rolling<0 then begin;
while SpiralGet(CurX,CurY) do {nothing};
dec(SizeXY[(CurDir+1) and 1]);
CurDir:=(CurDir+2) and 3;
No:=SizeXY[CurDir and 1];
DDir:=-DDir;
Roll:=-1;
Rest:=SizeX*SizeY;
end

end;

function SpiralGet(var X, Y: integer): boolean;
begin;
SpiralGet:=false;
if Rest>0 then begin;
SpiralGet:=true; X:=CurX; Y:=CurY;
dec(Rest);
if Rest>0 then begin;
if No<=0 then begin;
CurDir:=(CurDir+DDir) and 3;
dec(SizeXY[CurDir and 1],Roll);
No:=SizeXY[CurDir and 1];
end;
inc(CurX,DeltaX[CurDir]);
inc(CurY,DeltaY[CurDir]);
dec(No);
end;
end;
end;

begin;
end.

Продолжу... :)

---

← →
Sha   (2002-12-20 08:46) [10]

program Spiral;
uses
Spirals;

const
Bound= 9; {макс. размерн. матрицы 10x10}
DeltaX: array[0..3] of integer= (1,0,-1,0); {горизонтальный шаг по напр.}
DeltaY: array[0..3] of integer= (0,1,0,-1); {вертикальный шаг по напр.}
var
Tx : text; {файл данных}
St : string; {строка для чтения данных}
Matrix : array[0..Bound,0..Bound] of char; {матрица с данными}
SizeX : integer; {ее размер по горизонтали}
SizeY : integer; {ее размер по вертикали}
StartX : array[0..3] of integer; {координаты углов}
StartY : array[0..3] of integer; {координаты углов}
Corner : integer; {начальный угол: 0..3}
DeltaDir: integer; {направление обхода: +1,-1}
Rolling : integer; {сворачивание/разворачивание: +1,-1}
SizeXY : array[0..1] of integer; {остаточные размеры}
CurDir : integer; {текущее направление}
CurX : integer; {текущая горизонтальная коор.}
CurY : integer; {текущая вертикальная коор.}
No : integer; {временная переменная}
begin;

Corner:=3; {0..3 левый верний, правый верхний, правый нижний, левый нижний}
DeltaDir:=1; {+1 по часовой, -1 против}
writeln;
writeln("Corner: ",Corner,
", Direction: ",DeltaDir);


assign(Tx,"spiral.dat"); reset(Tx);
readln(Tx,SizeY,SizeX); {SizeY:=5; SizeX:=6;}
if (SizeX<1) or (SizeX>Bound+1)
or (SizeY<1) or (SizeY>Bound+1) then halt;

writeln; writeln("Matrix[",SizeY,",",SizeX,"]:");
for No:=0 to SizeY-1 do begin;
readln(Tx,St); St[0]:=Chr(SizeX); writeln(St);
move(St[1],Matrix[No,0],SizeX);
end;
close(Tx);

StartX[0]:=0;
StartX[1]:=SizeX-1;
StartX[2]:=SizeX-1;
StartX[3]:=0;

StartY[0]:=0;
StartY[1]:=0;
StartY[2]:=SizeY-1;
StartY[3]:=SizeY-1;

SizeXY[0]:=SizeX;
SizeXY[1]:=SizeY;

CurDir:=(Corner+(1-DeltaDir) shr 1) and 3;
CurX:=StartX[Corner]-DeltaX[CurDir];
CurY:=StartY[Corner]-DeltaY[CurDir];

writeln;
writeln(CurDir," ",CurX," ",CurY," ",SizeXY[0]," ",SizeXY[1]);
writeln("---------------------------------------------------------------");
while (SizeXY[0]>0) and (SizeXY[1]>0) do begin;
for No:=1 to SizeXY[CurDir and 1] do begin;
inc(CurX,DeltaX[CurDir]);
inc(CurY,DeltaY[CurDir]);
write(" ",Matrix[CurY,CurX]);
end;
CurDir:=(CurDir+DeltaDir) and 3;
dec(SizeXY[CurDir and 1]);
end;
writeln(" !");

writeln("---------------------------------------------------------------");
while (SizeXY[0]<SizeX) or (SizeXY[1]<SizeY) do begin;
inc(SizeXY[CurDir and 1]);
CurDir:=(CurDir-DeltaDir) and 3;
for No:=1 to SizeXY[CurDir and 1] do begin;
write(" ",Matrix[CurY,CurX]);
dec(CurX,DeltaX[CurDir]);
dec(CurY,DeltaY[CurDir]);
end;
end;
writeln(" !");

writeln("---------------------------------------------------------------");
writeln(CurDir," ",CurX," ",CurY," ",SizeXY[0]," ",SizeXY[1]);
writeln;


if SpiralInit(SizeX,SizeY,Corner,DeltaDir,1)
then while SpiralGet(CurX,CurY) do write(" ",Matrix[CurY,CurX]);
writeln(" !");

if SpiralInit(SizeX,SizeY,Corner,DeltaDir,-1)
then while SpiralGet(CurX,CurY) do write(" ",Matrix[CurY,CurX]);
writeln(" !");

readln;
end.

---

← →
zavdim   (2002-12-20 08:55) [11]

Что-то длинное все.
Я недавно баловался - правда,разворачивал спираль.
в центре 1, потом строим также, но разворачиваем если число простое - черным цветом, если составное белым (1 - как хочешь). Я числа не писал, а на канве точки ставил - картинку получал.
В одной статье прочитал, что интересная картина получится.
Так у меня разворот вроде сильно покороче был - код дома, а счас лень писать.

---

Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2003.01.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.019 c