Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Помогите с процедурами(TP), Составить подпрограмму в програмке 
V
    Опции темы
yura3
Дата 24.11.2010, 15:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Доброго времени суток! Очень надеюсь, что найдутся добрые люди, которые смогут помочь 
доделать программу, потому что от этого зависит судьба зачёта)

Итак, ближе к делу. Сделать правильно работающую программу у меня получилось. Задание состояло в следующем:
"Дана матрица А порядка N. Получить матрицу B меньшего порядка, состоящую из A(I,J), которые делятся на i+j. Элементы одной строки, попавшие в матрицу B должны составить так же одну строку. Если число элементов в разных строках матрицы B различно, недостающие элементы сделать нулевыми. Строки и столбцы, состоящие из одних нулей, не включать. Вывести исходную и полученную матрицы."

Теперь осталось оформить определение числа столбцов и строк в матрице В подпрограммой, т.е. через процедуры, что у меня пока не выходит. Также необходимо cделать так, чтобы результат программы сохранялся в отдельном файле(по-моему, в блокноте), но это уже не обязательно. Мне бы с процедурами разобраться...

Вот текст программы (turbo pascal):
Код

Uses crt;
const max=100;
var
  A:array[1..max,1..max] of integer;
  B:array[1..max,1..max] of integer;
  I,J,K,N,stolb,strok:integer;
  Z:boolean;
begin
  ClrScr;
  Randomize;
  writeln('Введите порядок матрицы');
  readln(N);
  writeln('-------Исходная матрица А-------');
  for I:=1 to N do
      for J:=1 to N do
          A[I,J]:=random(99);

  for I:=1 to N do
      begin
           for J:=1 to N do
           write(A[I,J]:3);
           writeln;
  end;
      readln;

  for I:=1 to N do
      for J:=1 to N do
            If A[I,J]/(I+J)=int(A[I,J]/(I+J)) then
               B[I,J]:=A[I,J]
            else
                B[I,J]:=0;

  stolb:=N; strok:=N;

{Начало подпрограммы}
  for I:=1 to N do
      begin
           Z:=true;
           for J:=1 to N do
               If B[I,J]<>0 then Z:=false;
           if Z then
              begin
                  strok:=strok-1;
                   if I<=N then
                      Begin
                       for K:=I+1 to N do
                           for J:=1 to N do
                               begin
                                    B[K-1,J]:=B[K,J];
                                    B[N,J]:=0;
                               end;
                      end;
                      I:=I-1;
              end;
              If I>=strok then break;
      end;

  for J:=1 to N do
      begin
           Z:=true;
           for I:=1 to N do
               If B[I,J]<>0 then Z:=false;
           if Z then
              begin
                  stolb:=stolb-1;
                   if J<=N then
                      begin
                       for K:=J+1 to N do
                           for I:=1 to N do
                               begin
                                    B[I,K-1]:=B[I,K];
                                    B[I,N]:=0;
                               end;
                      end;
                      J:=J-1;
              end;
           If J>=stolb then break;
      end;
{конец подпрограммы}
      writeln('-------Полученная матрица В-------');
      for I:=1 to strok do
          begin
           for J:=1 to stolb do
           write(B[I,J]:3);
           writeln;
          end;
      readln;
end.


Это сообщение отредактировал(а) yura3 - 24.11.2010, 15:31
PM MAIL   Вверх
Avada
Дата 24.11.2010, 16:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Цитата

Итак, ближе к делу. Сделать правильно работающую программу у меня получилось. 

если я правильно понял, матрицу В вы уже сформировали и теперь вам то же самое надо
сделать в делфи?
PM MAIL   Вверх
yura3
Дата 25.11.2010, 00:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Да, вся программа уже написана,только не в Delphi, а на Турбо Паскале. И задача состоит не в том, чтобы переписать её с одного языка на другой. Нужно только вставить процедуру, где формируется матрица В и сделать так, чтобы результат всей программы записывался в отдельный файл, что я вообще честно говоря не представляю, как делать.
PM MAIL   Вверх
darkart
Дата 25.11.2010, 11:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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



Код

program matrixAB;

const
  MAX_MATRIX_DIM = 4;{размерность исходной матрицы}
  OUTPUT_FILE_NAME = 'output.txt';{имя выходного файла}

type
  TMatrixString = array[ 1..MAX_MATRIX_DIM ] of integer;{описание типа строки матрицы}
  TMatrix = array [ 1..MAX_MATRIX_DIM ] of TMatrixString;{описание типа матрицы}

procedure InputMatrix( var matrix : TMatrix );
{процедура ввода матрицы}
var
  i, j : integer;{счетчики}
begin
  for i := 1 to MAX_MATRIX_DIM do{для каждой строки матрицы}
  begin
    for j := 1 to MAX_MATRIX_DIM do{для каждого элемента строки}
      read( matrix[ i, j ] );{читаем очередной элемент матрицы}
    readln;{читаем ввод}
  end;
end;

procedure PrintMatrixToFile( var fil : text; var matrix : TMatrix; rows, cols : integer );
{процедура печати матрицы matrix, размерности rows на cols элементов в файл fil}
var
  i, j : integer;
begin
  if ( rows = 0 ) or ( cols = 0 ) then{ считаем матрицу без строк или столбцов - пустой }
    writeln( fil, 'Empty matrix.' ){пустая матрица}
  else
  begin
    for i := 1 to rows do{для каждой строки матрицы}
    begin
      for j := 1 to cols - 1 do{для каждого элемента строки, кроме последнего}
        write( fil, matrix[ i, j ], ' ' );{печатаем очередной элемент и пробел}
      writeln( fil, matrix[ i, cols ] );{печатаем последний элемент строки с переводом курсора}
    end;
  end;
end;

procedure PrintResToFile( var fil : text; var A, B : TMatrix; rows, cols : integer );
{процедура печати результата в файл fil}
begin
  writeln( fil, 'Matrix A :' );
  PrintMatrixToFile( fil, A, MAX_MATRIX_DIM, MAX_MATRIX_DIM );{печать исходной матрицы}
  writeln( fil, 'Matrix B:' );
  PrintMatrixToFile( fil, B, rows, cols );{печать сгенерированной матрицы}
end;

function GenerateMatrixString( var srcMatrixString, dstMatrixString : TMatrixString; num : integer ) : integer;
{
 функция генерации строки матрицы по заданному условию,
 в новую строку попадают элементы исходной строки, которые
 делятся без остатка на сумму координат в матрице, при этом
 в функцию передается параметр num, который должен быть равен
 номеру строки в исходной матрице
}
var
  i, res : integer;{ i - счетчик, res - результат( количество элементов в новой строке )}
begin
  res := 0;{инициализация результата}
  for i := 1 to MAX_MATRIX_DIM do{для каждого элемента строки}
    if srcMatrixString[ i ] mod ( i + num ) = 0 then{если элемент удовлетворяет условию}
    begin
      inc( res );{увеличение результата}
      dstMatrixString[ res ] := srcMatrixString[ i ];{добавляем очередной элемент строки}
    end;
  GenerateMatrixString := res;{возвращаем результат}
end;

procedure GenerateMatrix( var srcMatrix, dstMatrix : TMatrix; var rows, cols : integer );
{
 процедура генерации матрицы по заданному условию
 возвращаемые значения в параметрах
 rows - количество строк в новой матрице
 cols - количество столбцов в новой матрице
}
var
  i, j, length : integer;{ i, j - счетчики, length - длина текущей сгенерированной строки }
  stringLengths : TMatrixString;{ массив, в котором хранятся длинны сгенерированных строк}
begin
  {инициализация}
  rows := 0;{количество строк}
  cols := 0;{количество столбцов}
  for i := 1 to MAX_MATRIX_DIM do{для каждой строки исходной матрицы}
  begin
    length := GenerateMatrixString( srcMatrix[ i ], dstMatrix[ rows + 1 ], i );{генерируем новую строку}
    if length > 0 then{если ее длина больше нуля}
    begin
      inc( rows );{увеличиваем количество строк}
      stringLengths[ rows ] := length;{запоминаем длину новой строки}
      if length > cols then{если длина новой строки больше текущего значения столбцов}
        cols := length;{запоминаем новое значение столбцов}
    end;
  end;
  {дополнение нулями новой матрицы}
  for i := 1 to rows do{для каждой строки новой матрицы}
    for j := stringLengths[ i ] + 1 to cols do{для элементов находящихся правее последне сгенерированного}
      dstMatrix[ i, j ] := 0;{обнуление}
end;

var
  rows, cols : integer;{rows - количество строк, cols - количество столбцов в новой матрице}
  A, B : TMatrix;{A - исходная матрица, B - сгенерированная по условию задачи}
  fil : text;{текстовый файл}

begin
  writeln( 'Please enter a matrix A:' );
  InputMatrix( A );{ввод исходной матрицы}
  GenerateMatrix( A, B, rows, cols );{генерация матрицы по условию задачи}

  PrintResToFile( OUTPUT, A, B, rows, cols );{печать результата в файл стандартного вывода}

  {печать результата в файл}
  assign( fil, OUTPUT_FILE_NAME );{связывание файловой переменной с файлом с заданным именем}
  rewrite( fil );{перезапись}
  PrintResToFile( fil, A, B, rows, cols );{печать результата в файл}
  close( fil );{закрываем файл}

  readln;{ожидание ввода}
end.


PM MAIL WWW ICQ Skype GTalk   Вверх
yura3
Дата 25.11.2010, 14:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Спасибо большое. Только в программировании я "дерево", поэтому знаю только именно turbo pascal (либо pascal ABC), да и то не очень.
Когда я скопировал текст программы в Turbo Pascal, он мне выдал кучу ошибок. Был бы очень благодарен, если бы вы перевели с одного языка на другой. Повторяю, я программировать начал только 2 месяца назад, так что пока плохо в этом разбираюсь smile 
PM MAIL   Вверх
darkart
Дата 25.11.2010, 20:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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



Попробуйте удалить комментарии... Вероятно это ограничение на длину строк кода.
Код

program matrixAB;

const
  MAX_MATRIX_DIM = 4;
  OUTPUT_FILE_NAME = 'output.txt';
  
type
  TMatrixString = array[ 1..MAX_MATRIX_DIM ] of integer;
  TMatrix = array [ 1..MAX_MATRIX_DIM ] of TMatrixString;
  
procedure InputMatrix( var matrix : TMatrix );
var
  i, j : integer;
begin
  for i := 1 to MAX_MATRIX_DIM do
  begin
    for j := 1 to MAX_MATRIX_DIM do
      read( matrix[ i, j ] );
    readln;
  end;
end;

procedure PrintMatrixToFile( var fil : text; var matrix : TMatrix; rows, cols : integer );
var
  i, j : integer;
begin
  if ( rows = 0 ) or ( cols = 0 ) then
    writeln( fil, 'Empty matrix.' )
  else
  begin
    for i := 1 to rows do
    begin
      for j := 1 to cols - 1 do
        write( fil, matrix[ i, j ], ' ' );
      writeln( fil, matrix[ i, cols ] );
    end;
  end;
end;

procedure PrintResToFile( var fil : text; var A, B : TMatrix; rows, cols : integer );
begin
  writeln( fil, 'Matrix A :' );
  PrintMatrixToFile( fil, A, MAX_MATRIX_DIM, MAX_MATRIX_DIM );
  writeln( fil, 'Matrix B:' );
  PrintMatrixToFile( fil, B, rows, cols );
end;

function GenerateMatrixString( var srcMatrixString, dstMatrixString : TMatrixString; num : integer ) : integer;
var
  i, res : integer;
begin
  res := 0;
  for i := 1 to MAX_MATRIX_DIM do
    if srcMatrixString[ i ] mod ( i + num ) = 0 then
    begin
      inc( res );
      dstMatrixString[ res ] := srcMatrixString[ i ];
    end;
  GenerateMatrixString := res;
end;

procedure GenerateMatrix( var srcMatrix, dstMatrix : TMatrix; var rows, cols : integer );
var
  i, j, length : integer;
  stringLengths : TMatrixString;
begin
  rows := 0;
  cols := 0;
  for i := 1 to MAX_MATRIX_DIM do
  begin
    length := GenerateMatrixString( srcMatrix[ i ], dstMatrix[ rows + 1 ], i );
    if length > 0 then
    begin
      inc( rows );
      stringLengths[ rows ] := length;
      if length > cols then
        cols := length;
    end;
  end;
  for i := 1 to rows do
    for j := stringLengths[ i ] + 1 to cols do
      dstMatrix[ i, j ] := 0;
end;

var
  rows, cols : integer;
  A, B : TMatrix;
  fil : text;
  
begin
  writeln( 'Please enter a matrix A:' );
  InputMatrix( A );
  GenerateMatrix( A, B, rows, cols );
  PrintResToFile( OUTPUT, A, B, rows, cols );
  assign( fil, OUTPUT_FILE_NAME );
  rewrite( fil );
  PrintResToFile( fil, A, B, rows, cols );
  close( fil );
  readln;
end.


PM MAIL WWW ICQ Skype GTalk   Вверх
yura3
Дата 25.11.2010, 22:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Нет, там не в этом дело: в процедуре procedure GenerateMatrix после второго begin-a возле srcMatrix[i] пишет "массив имеет другое количество размерностей"


Возможно, это связано с тем, что я заменил в type "TMatrix = array [ 1..MAX_MATRIX_DIM ] of TMatrixString;"  на   "TMatrix = array [ 1..MAX_MATRIX_DIM, 1..MAX_MATRIX_DIM] of integer;"
Но иначе не работают предыдущие процедуры:
    Procedure InputMatrix .....
 ...read( matrix[ i, j ] );----"массив имеет другое количество размерностей!!"

Честно говоря, разбираться в чужой программе мне гораздо сложней, поэтому я не знаю, что делать.
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »


 




[ Время генерации скрипта: 0.0742 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.