VPF::Квадратная матрица - Форум программистов

Princess

Дата 2.12.2007, 13:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 28.11.2007

Репутация: нет
Всего: нет

Как организовать ввод данных в квадратную матрицу размерностью N*N ?
И работу с этими данными?
Подскажите, буду очень признательна

Alkash

Дата 2.12.2007, 17:20 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

Пример работы с квадратной матрицей, думаю поможет разобраться.
Авторство к сожалению не известно, нашёл на харде в загашниках.

Код


program matrix;

{$APPTYPE CONSOLE}

uses
  SysUtils;
const
n = 4; // это размерность нашей матрицы. Если хочешь много всякой всячины на экране чтобы
// написано было замени на 8 , если хочешь чтобы легче проверять было замени на 2

var
a,b: array[1..2*n,1..2*n] of integer; // a - начальная квадратная матрица, b - конечная матрица
i,j: integer;  // вспомогательные переменные
r11,r12,r21,r22 : integer; //расстояния в каждом из блоков
R : integer; // минимальное расстояние
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Procedure MinMax7(const iFrom,iTo, jFrom,jTo: integer; var Distance : integer);
// Процедура получает координаты расчитываемого квадрата
// записывает в конечную матрицу b семерки ( в этом квадрате)
// на месте максимума  и минимума соответсвенно
// а также возвращает расстояние между минимумом и максимумом
var
Min, Max: integer; // временные минимумы и максимумы
i,j: integer;  // вспомогательные переменные
iMin, iMax, jMin, jMax: integer; // координаты минимумов и максимумов
begin
// to do
  Min:= 100; // начальный минимум делаем огромным
  Max:=-100; // а максимум минимальным
  iMin:=0;
  jMin:=0;
  iMax:=0;
  jMax:=0;
  for i:= iFrom to iTo
  do for j:= jFrom to jTo
     do begin
         if a[i,j]< Min // если число меньше текущего минимума
         then begin
               Min:= a[i,j]; // то текущий минимум приравниваем к этому числу
               iMin:= i;  // а координаты этого
               jMin:= j;  // числа запоминаем
              end;
         if a[i,j]> Max  // аталогично поступаем если число больше текущего максимума
         then begin
               Max:= a[i,j];
               iMax:= i;
               jMax:= j;
              end;
        end;
  Distance:= abs(iMin-iMax) + abs(jMin-jMax); //сумма  модулей разниц в координатах
  //думаю это имелось ввиду под расстоянием между минимумом и максимумом...
  //если нужен был корень из суммы квадратов разниц координат (на манер расстояний в векторах)
  //значит надо будет программу немного переделать расстояние считаться будет так:
  //Distance:=  sqrt(sqr(iMin-iMax) + sqr(jMin-jMax));
  //и расстояния эти уже будут не integer  а real (то есть дробные)

  b[iMin,jMin]:=-7; // заменяем в конечной матрице минимальное в квадрате число на -7
  b[iMax,jMax]:= 7; // заменяем в конечной матрице максимальное в квадрате число на 7
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

begin
randomize;   //запускаем генератор случайных чисел
writeln('Generating matrix');
   for i:= 1 to 2*n
  do begin
      for j:= 1 to 2*n
      do begin
          a[i,j]:= random(198)-99; //генерируем число от -99 до 99
          if a[i,j]> -1 then  write(' '); // рисуем один пробел, если не надо писать минус ( число больше -1)
          write(a[i,j],' '); // пишем само число
          if abs(a[i,j])< 10 then  write(' ');// и если  число из одной цифры состоит добавляем еше пробел
          if j= n then write('  ');// это чтобы были видны блоки
         end;
      writeln; // чтобы новый ряд писался с новой строки
      if i= n then writeln;// это тоже чтобы были видны блоки
     end;
  writeln;
  b:=a; // Конечному массиву присваиваем перво наперво начальный массив

  MinMax7(1,n,1,n, r11);// находим семерки в левом верхнем квадрате
  MinMax7(n+1,2*n,1,n, r21);// находим семерки в правом верхнем квадрате
  MinMax7(1,n,n+1,2*n, r12);// находим семерки в левом нижнем  квадрате
  MinMax7(n+1,2*n,n+1,2*n, r22);// находим семерки в правом нижнем  квадрате

  writeln('Press ENTER...');
  readln;
  writeln('Final Matrix is:');  //выводим финальную матрицу
  writeln;

  for i:= 1 to 2*n
  do begin
      for j:= 1 to 2*n
      do begin
          if b[i,j]> -1 then  write(' '); // рисуем один пробел, если не надо писать минус ( число больше -1)
          write(b[i,j],' '); // пишем само число
          if abs(b[i,j])< 10 then  write(' ');// и если  число из одной цифры состоит добавляем еше пробел
          if j= n then write('  ');// это чтобы были видны блоки
         end;
      writeln; // чтобы новый ряд писался с новой строки
      if i= n then writeln;// это тоже чтобы были видны блоки
     end;

  writeln;
  R:=99; // ищем минимальное расстояние
  if r11< R then R:= r11;
  if r12< R then R:= r12;
  if r21< R then R:= r21;
  if r22< R then R:= r22;

  Writeln('Min distance between minimum and maximum is : ',R);
  if R= r11 then writeln('Quadrant with min distance is upper left ');
  if R= r12 then writeln('Quadrant with min distance is upper right ');
  if R= r21 then writeln('Quadrant with min distance is lower left ');
  if R= r22 then writeln('Quadrant with min distance is lower right ');

  writeln('Press ENTER...');
  readln;
end.

--------------------

Подпись >> /dev/null

Princess

Дата 2.12.2007, 23:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 28.11.2007

Репутация: нет
Всего: нет

Забыла... нужно в Delphi

Alkash

Дата 2.12.2007, 23:45 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

А это в чём smile

--------------------

Подпись >> /dev/null

Princess

Дата 3.12.2007, 11:02 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 28.11.2007

Репутация: нет
Всего: нет

язык программирования smile

Alexeis

Дата 3.12.2007, 11:38 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459

Princess, это и есть Delphi просто, проект консольный, а не GUI.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Princess

Дата 3.12.2007, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 28.11.2007

Репутация: нет
Всего: нет

Код


unit Unit1;

interface

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

type
    TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    Label3: TLabel;
    StringGrid2: TStringGrid;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    BitBtn1: TBitBtn;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
     private
    { Private declarations }
  public
    { Public declarations }
  end;
 const nn=10;
 type matr1=array [1..nn,1..nn] of real;
var
  Form1: TForm1;
  n:integer;
  b,d:matr1;
implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
edit1.SetFocus;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
n:=strtoint(edit1.text);
if(n>nn)
then begin showmessage('íåâåðíûé ââîä');
edit1.text:='';
exit;
end;
stringgrid1.colcount:=N+1;
stringgrid1.rowcount:=N+1;
for i:=1 to n do
for j:=1 to n do
begin stringgrid1.cells[j,i]:='';
stringgrid1.cells[0,i]:=inttostr(i);
stringgrid1.cells[j,0]:=inttostr(j);
end;
stringgrid1.SetFocus;
label2.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
memo1.Clear;
 memo1.Lines.Add('Ìàòðèöà À');
for i:=1 to n do
   begin
      for j:=1 to n do
          begin
             b[i,j]:=strtofloat(stringgrid1.Cells[j,i]);
             memo1.Text:=memo1.Text+' '+floattostr(B[i,j])
          end;                 // çàêîí÷èëè âûâîä ñòðîêè
      memo1.lines.add('');  //ïåðåõîä íà íîâóþ
   end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
    begin
    stringgrid1.cells[j,i]:='';
    end;
    edit1.Text:='';
    memo1.Clear;
    Label2.Hide;
    Edit1.SetFocus;

end;
end.

Где здесь ошибка? :( у меня не выводится первая матрица :(

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »