Помощь - Поиск - Пользователи - Календарь
Полная версия: Делаю из двухмерного массива одномерный выбором членов по спирали
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
jarded
6.10.2006 19:32
прога работает только при одинаковых n и m, (квадратный массив)
А как заставить ее работать в прямоугольном массиве?
wacko.gif
Код
PROGRAM KR1;

CONST
n=5;
m=5;
k=100;
r=100;
VAR
B:array[1..r] of integer;
A:array[1..n,1..m] of real;
i,j,c,mm,nn,mmm,nnn:integer;

Procedure FINDINT;
begin
B[c]:=Trunc(A[i,j]);
write(B[c],'  ');
c:=c+1;
end;
BEGIN
Writeln;
write('-------------------------------------------------');
Writeln;
Write('generatsiya massiva');
  begin {nachalo generatsii massiva}
   randomize;
   for i:=1 to n do
   for j:=1 to m do
   A[i,j]:=random(k);
  end;{konets generatsii massiva}
i:=1;
j:=1;

Writeln;
Writeln('-------------------------------------------------');
  while i<=m do
   begin
   writeln;
     while j<=n do
      begin
      write(A[i,j]:1:2,'  ');
      j:=j+1
      end;
   i:=i+1;
   j:=1;
   end;
Writeln;
write('-------------------------------------------------');
Writeln;
write('massiv sgenerirovan');
Writeln;
write('-------------------------------------------------');
writeln;
i:=1;
j:=1;
c:=1;
mmm:=1;
nnn:=1;
mm:=m;
nn:=n;

while mmm<=mm do {glavniy cikl}
begin
while nnn<=nn do
begin

while j<=mm do {vpravo}
begin
  FINDINT; j:=j+1;
end;
j:=mm;
nnn:=nnn+1;
i:=nnn;

while i<=nn do {vniz}
begin
  FINDINT; i:=i+1;
end;
i:=nn;
mm:=mm-1;
j:=mm;

while j>=mmm do {vlevo}
begin
  FINDINT;   j:=j-1;
end;
j:=mmm;
nn:=nn-1;
i:=nn;
while i>=nnn do {vverh}
begin
  FINDINT; i:=i-1;
  end;
i:=nnn;
mmm:=mmm+1;
j:=mmm;
  end;
  end;
Writeln;
write ('SUMMA CHLENOV=',c-1);

ReadLn;

END.
volvo
6.10.2006 19:38
Цитата
А как заставить ее работать в прямоугольном массиве?
Воспользоваться поиском:
ДВУХМЕРНЫЕ МАССИВЫ

(насколько я вижу, в той программе надо изменить 4 символа, чтобы она корректно работала, как тебе нужно... Дерзай! wink.gif )
jarded
9.10.2006 15:12
wacko.gif не получается
volvo
9.10.2006 20:45
Цитата(jarded @ 9.10.2006 10:12)
wacko.gif не получается

Что ж тут может не получиться?

const
  n = 5;
  m = 7;
  k = -1;
type
  mxType = array[1 .. n, 1 .. m] of integer;
const
  arr: mxType =
    ((1, 2, 3, 4, 5, 6, 7),
     (*
     (2, 3, 4, 5, 6, 7, 8),
     (3, 4, 5, 6, 7, 8, 9),
     *)
     (2, 3, 4, 5, 6, 7, 8),
     (1, 5, 3, 2, 8, 7, 6),
     (8, 3, 2, 9, 0, 3, 2),
     (9, 8, 7, 6, 5, 4, 3));

var
  lin: array[1 .. n * m] of integer;
  i, j, count: integer;

begin
  count := 0;

  i := 1; j := 1;
  repeat

    while (j < succ(m)) and (arr[i, j] <> K) do begin
      inc(count); lin[count] := arr[i, j]; arr[i, j] := K;
      inc(j);
    end;
    dec(j); inc(i);
    while (i < succ(n)) and (arr[i, j] <> K) do begin
      inc(count); lin[count] := arr[i, j]; arr[i, j] := K;
      inc(i)
    end;
    dec(i); dec(j);
    while (j > 0) and (arr[i, j] <> K) do begin
      inc(count); lin[count] := arr[i, j]; arr[i, j] := K;
      dec(j)
    end;
    inc(j); dec(i);
    while (i > 0) and (arr[i, j] <> K) do begin
      inc(count); lin[count] := arr[i, j]; arr[i, j] := K;
      dec(i)
    end;
    inc(i); inc(j);

  until count = n * m;

  for i := 1 to count do
    write(lin[i]:4);
  writeln;
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.