Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.01.2010, 12:44   #1
ilgar-90
 
Регистрация: 08.01.2010
Сообщений: 8
Вопрос Проход матрицы зизагом. Delphi

Здравствуйте. Помогите пожалуйста исправить алгоритм. Задача такая: необходимо вывести матрицу в одномерный массив проходя его зигзагом.
К примеру матрицу:
1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 16
надо вывести в одномерный массив: 1 2 5 9 6 3 4 7 10 13 14 11 8 12 15 16.

Я нашел исходник на Си: http://forum.developing.ru/showthread.php?12325

и переделал его для Delphi:

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const N=8;
var i,j,x,l,p,y:integer;
a:array [1..8,1..8] of integer;
b:array [1..64] of integer;
begin
Randomize;
for i:=1 to N do begin
for j:=1 to N do begin
a[i,j]:=Random(50);                                  // ucXogHblu MaccuB
StringGrid1.Cells[i-1,j-1]:=Inttostr(a[i,j]);    //массив в стринггриде
end;
end;


for l:=1 to N*2 do begin 
if (l<=N)
then p:=l
else p:=N*2-l;

  for y:=0 to p do begin
  if odd(l) // проверка четности диагонали. Если четная то направление вниз, если нечетная то направление вверх.
  then begin
    if (l<=N)
    then begin
      for i:=p downto 1 do begin
      for j:=1 to p do begin
      b[j*N+i]:=a[i,j];
      end;
      end; end
    else
      for i:=N downto p do begin
      for j:=p to N do begin
      b[j*N+i]:=a[i,j];
      end;
      end;
    end
  else
    if (l<=N)
    then begin
      for i:=p downto 1 do begin
      for j:=1 to p do begin
      b[j*N+i]:=a[i,j];
      end;
      end; end
    else
      for i:=N downto p do begin
      for j:=p to N do begin
      b[j*N+i]:=a[i,j];
      end;
      end;
  end;

end;

for i:=1 to 64 do begin
StringGrid2.Cells[i,1]:=IntToStr(b[i]); //вывод строки в стринггрид
end;

end;
end.
Но что то он у меня не работает, при запуке выплевывает ошибку..у мя мозг плавится не знаю за что уцепиться...Помогите кто чем может! Спасибо за внимание!

Последний раз редактировалось Stilet; 28.08.2015 в 20:22. Причина: Недоработки...
ilgar-90 вне форума Ответить с цитированием
Старый 09.01.2010, 18:47   #2
eoln
Старожил
 
Аватар для eoln
 
Регистрация: 26.04.2008
Сообщений: 2,689
По умолчанию

Предложу лишь алгоритм
Код:
const
  n = 3;
var
  b: array[1..n, 1..n] of byte;
  i, j, k: byte;
begin
  for i := 1 to n do for j := 1 to n do b[i, j] := (i-1)*n + j;

  for i := 1 to n do begin
    for j := 1 to n do write(b[i, j]:3);
    writeln
  end;

  //алгоритм для квадратной матрицы
  for i := 1 to 2 * n - 1 do
  begin
    if i > n then k := n else k := i; //ограничение для строк
    if i mod 2 = 1 then //вверх
      for j := 1 + i - k to k do write(b[1 - j + i, j]:3)
    else //вниз
      for j := k downto 1 + i - k do write(b[1 - j + i, j]:3)
  end;

  readln
end.
При решении таких задач, имхо надо идти от частного к общему. А именно, сначала вывести одну диагональ, затем попытаться вывести все диагонали (при этом прослеживаем закономерность изменения координат). В итоге получаем краткую запись.
eoln вне форума Ответить с цитированием
Старый 28.08.2015, 19:54   #3
zesava
Новичок
Джуниор
 
Регистрация: 15.06.2009
Сообщений: 1
По умолчанию

возможно кому то будет полезным. Алгоритм для не квадратной матрицы.

b - матрица любого размера, s - строка результатов.

Код:
var
  i, m, n, y, x, yFrom, yTo, xFrom, xTo: Integer;
begin
  m := Length(b);
  n := Length(b[0]);
  s := '';

  for i := 0 to m + n - 1 do
  begin
    if i mod 2 = 1 then
    begin
      if i < n - 1 then yFrom := i
      else yFrom := n - 1;

      if 0 > i - m + 1 then yTo := 0
      else yTo := i - m + 1;

      for y := yFrom downto yTo do
        s := s + IntToStr(b[i - y, y]) + ' ';
    end

    else
    begin
      if i < m - 1 then xFrom := i
      else xFrom := m - 1;

      if 0 > i - n + 1 then xTo := 0
      else xTo := i - n + 1;

      for x := xFrom downto xTo do
        s := s + IntToStr(b[x, i - x]) + ' ';
    end;
  end;
  mmo1.Lines.Add(s);
end;

Последний раз редактировалось zesava; 28.08.2015 в 19:59.
zesava вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разбор программы на логические блоки в один проход Utkin Общие вопросы Delphi 23 27.07.2009 10:15
С++. Отыскать проход по лабиринту Romer9999 Помощь студентам 1 17.06.2009 23:33
Проход по дереву. Ozerich Общие вопросы Delphi 1 05.10.2008 17:33
Сортирование масивов за один проход NightWishMaster Паскаль, Turbo Pascal, PascalABC.NET 10 18.10.2007 08:05
Повторный проход по записям в TIBQuery novicer Компоненты Delphi 0 19.06.2007 18:58