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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 19.01.2017, 19:21   #1
Программистер
Пользователь
 
Регистрация: 12.01.2017
Сообщений: 10
По умолчанию Подправить фрагмент кода

Условие:
Дана матрица A, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn по правилу:
Хi = 1, если для всех j = l, 2, ..., n (кроме j=i) выполняется неравенство Aji< Aij, иначе Xi = 0
. Найти сумму
элементов матрицы.

Рабочий код(почти):
Код:
program Lab11procedure;
  {$APPTYPE CONSOLE}
  const
  nmax=5;
  mmax=20;
Type SMas=array[2..nmax,2..nmax] of integer;
Type Mas=array[1..mmax] of integer;
Procedure VvodVyvod(var dat,res: TextFile; var n: integer; var A: SMas; var name: char);
Var i,j: byte;
begin
  readln(dat, name);
  readln(dat,n);
  i:=1;
    while(i <= n) do
    begin
      j:= 1;
    while(j <= n) do
    begin
      read(dat,A[i,j]);
      j:= j+1;
    end;
  i:= i+1;
  readln(dat);
end;
  writeln(res, 'Иcходная матрица ',name,'[i,j] из ',n,' строки ',n,' столбцов');
  i:= 1;
    while(i <= n) do
    begin
      j:=1;
    while(j <= n) do
    begin
      write(res,A[i,j]:4,' ');
      j:= j+1;
    end;
  i:= i+1;
  writeln(res);
    end;
end;
Procedure PoiskMassiva (const n:integer;var A: SMas; out X:Mas;Vse,Odin:Boolean);
var i,j: byte;
begin
  Vse:=True;
  i:=1;
  repeat
    Odin:=False;
    j:=1;
    repeat
      if (A[j,i]<A[i,j]) and (A[j+1,i]<A[i,j+1]) and (j<>i) then
        X[i]:=1
      else
        Odin:=True;
        X[i]:=0;
    until (j<=n) or (not Odin);
    if Odin then
    begin
      Vse:=False;
      X[i]:=0
    end
    else
      i:=i+1;
  until (i<=n) or (not Vse);
end;
Procedure SummaVsex(const n:integer;var A:SMas; out SUM: integer);
var i,j: byte;
begin
  SUM:=0;
    for i:=1 to n do
    for j:=1 to n do
      SUM:=SUM+A[i,j];
end;

var
  A,B,C:SMas;
  X:Mas;
  MinSum,SUM,SUMA,SUMB,SUMC,i,j,n:integer;
  dat1,dat2,dat3,res:TextFile;
  name:char;
  Vse,Odin:Boolean;
begin
      AssignFile(dat1,'dat11(A).txt');reset(dat1);
      AssignFile(dat2,'dat11(B).txt');reset(dat2);
      AssignFile(dat3,'dat11(C).txt');reset(dat3);
      AssignFile(res,'res11.txt');rewrite(res);
        VvodVyvod(dat1,res,n,A,name);
        PoiskMassiva(n,A,X,Vse,Odin);
          write(res,'Массив Xn(А) = ');
            for i:=1 to n do write(res,X[i]:4,' ');
            writeln(res);
        SummaVsex(n,A,SUM);
          SUMA:=SUM;
          writeln(res,'Сумма всех элементов матрицы A = ',SUMA);
          writeln(res,'----------------------------------------------');
        VvodVyvod(dat2,res,n,B,name);
        PoiskMassiva(n,B,X,Vse,Odin);
          write(res,'Массив Xn(B) = ');
            for i:=1 to n do write(res,X[i]:4,' ');
            writeln(res);
        SummaVsex(n,B,SUM);
          SUMB:=SUM;
          writeln(res,'Сумма всех элементов матрицы B = ',SUMB);
          writeln(res,'----------------------------------------------');
        VvodVyvod(dat3,res,n,C,name);
        PoiskMassiva(n,C,X,Vse,Odin);
          write(res,'Массив Xn(C) = ');
            for i:=1 to n do write(res,X[i]:4,' ');
            writeln(res);
        SummaVsex(n,C,SUM);
          SUMC:=SUM;
          writeln(res,'Сумма всех элементов матирцы C = ',SUMC);
          writeln(res,'----------------------------------------------');
          if (SUMA<SUMB) and (SUMA<SUMC) then
            writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица A = ',SUMA)
            else
          if (SUMB<SUMA) and (SUMB<SUMC) then
            writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица B = ',SUMB)
            else
          if (SUMC<SUMA) and (SUMC<SUMB) then
            writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица C = ',SUMC)
            else
          if (SUMA=SUMB) and (SUMA<SUMC) then
            writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы А и B = ',SUMA)
            else
          if (SUMB=SUMC) and (SUMB<SUMA)then
            writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы B и С = ',SUMB)
            else
          if (SUMA=SUMC) and (SUMC<SUMB) then
            writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы А и C = ',SUMA)
            else
          if (SUMA=SUMB) and (SUMA=SUMC) then
            writeln(res,'Значение суммы всех элементов каждой матрицы совпадает и равняется = ',SUMA,'.Минимальное значение отсутствует.')
            else
          writeln(res,'----------------------------------------------');
          CloseFile(dat1);
          CloseFile(dat2);
          CloseFIle(dat3);
          CloseFile(res);

end.
Выходной файл(фрагмент для матрицы А) :
Иcходная матрица А[i,j] из 3 строки 3 столбцов
-2 7 7
6 5 14
5 3 0
Массив Xn(А) = 0 0 0 , а должно быть 1 0 0 ,т.к А(21)<A12 и A(31)<A(13)
Сумма всех элементов матрицы A = 45
----------------------------------------------

Подскажите , как подправить цикл?Заранее Спасибо!
Программистер вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Объясните фрагмент кода ka11n Общие вопросы C/C++ 4 04.09.2014 16:27
Фрагмент кода по алгоритму Студент8565 Помощь студентам 4 12.05.2013 17:42
Удалить фрагмент из кода DeadWarlock Общие вопросы Delphi 2 03.02.2012 00:26
Фрагмент кода программы Delphi Начинающий програм Помощь студентам 2 21.01.2012 23:41
Фрагмент кода С++ Роман Кор Общие вопросы C/C++ 6 22.02.2009 19:25