• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о форуме и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Обработка квадратной матрицы

  • Автор темы Автор темы citrus
  • Дата начала Дата начала
вот, посмотрите пожалуйста, буду Вам очень благодарен!)
 

Вложения

Так, ну отладил я Вашу программу. Ошибок очень много, но ничего страшного, научитесь. Пара замечаний общего характера:
1. Вы, похоже, не разобрались с заданием параметров процедур и функций, тех, что идут в скобках после имени подпрограммы. Тут так. Слово "var" при перечислении параметров ФУНКЦИИ вообще ставить не надо; в то же время в ПРОЦЕДУРЕ оно играет ключевую роль: ВХОДНЫЕ параметры перечисляются БЕЗ "var", ВЫХОДНЫЕ - с "var".
2. Не обязательно, но ОЧЕНЬ желательно - пользуйтесь при написании программы паскалевскими "лесенками"! Без них читать текст программы очень трудно. А у Вас на вид прямо не Паскаль, а Фортран какой-то.
Теперь сама программа:
Код: 
Program Tipovik;
uses crt;
Type MAS=Array [1..10,1..10] of Real;
     Vec=Array [1..10] of Real;
Var A,B,A1,B1:MAS;
    W:Vec;
    N,M,k:Byte;
    Q1,Q2:real;

Procedure VVOD (var x:mas; C:Byte);
 Var i,j:Byte;
  Begin
   For i:=1 to C do
    For j:=1 to C do
     begin
      WriteLn ('vvedite element s indeksom',i,' ',j);
      ReadLn (x[i,j]);
     end;
  end;

Procedure VYVOD (x:mas; C:Byte);
 Var i,j:Byte;
 Begin
  For i:=1 to C do
   begin
    For j:=1 to C do
     Write (x[i,j]:6:2);
    WriteLn;
    end;
 end;

Procedure VYVOD_Vec (y:vec; C:Byte);
 Var j:Byte;
  begin
   For j:=1 to C do
    Write (y[j]:6:2);
    WriteLn;
   end;


Function Up (x:mas; C:Byte):Real;
 Var i,j,T:byte;
     Fl:boolean;
Begin
 T:=0;
 For i:=1 to C do
  begin
   Fl:=true;
   For j:=1 to C-1 do
    If x[i,j]<x[i,j+1] then Fl:=false;
   if Fl then  T:=T+1;
  end;
 Up:=T;
End;

Procedure perestanovka (x:mas; C,z:Byte; var y:mas);
 Var i,j,m,Jfix:Byte;
     Fl:boolean;
     dub:real;
     v:Vec;
 Begin
  For j:=1 to C do
   v[j]:=x[z,j];
  For m:=1 to C do
   begin
    dub:=1000000.0;
    For j:=1 to C do
     if v[j]<dub then
      begin
       dub:=v[j];
       Jfix:=j;
      end;
    v[Jfix]:=1000000.0;
    For i:=1 to C do
     y[i,m]:=x[i,Jfix];
   end;
 End;

Procedure FV (x:mas; var y:vec; C:Byte);
 Var i,j:Byte;
     max:Real;
 Begin
  For i:=1 to C do
   begin
    max:=x[i,1];
    For j:=1 to C do
     If Abs(x[i,j])>max then
      begin
       max:=x[i,j];
       W[i]:=max;
      end;
   end;
 End;

Begin
 clrscr;
 WriteLn ('Vvedite kol-vo strok i stolbcov matrici A ');
 ReadLn (N);
 WriteLn ('Vvedite kol-vo strok i stolbcov matrici B');
 ReadLn (M);
 If (N<=0) or (N>10) or (M<=0) or (M>10) then
  WriteLn ('neverno vvedeni znacheniy')
 else
 begin
  WriteLn ('Vvod matrici A');
  VVOD (A,N);
  WriteLn ('Vvod matrici B');
  VVOD (B,M);
  clrscr;
  WriteLn ('Isxodniy massiv A');
  VYVOD (A,N);
  WriteLn;
  WriteLn ('Isxodniy massiv B');
  VYVOD (B,M);
  WriteLn;
  WriteLn ('Vvedite K-yu stroku');
  ReadLn (k);
  WriteLn;
  Q1:=Up(A,N);
  WriteLn ('Kol-vo uporyd strok A',' ',Q1:6:2);
  WriteLn;
  Q2:=Up(B,M);
  WriteLn ('Kol-vo uporyd strok B',' ',Q2:6:2);
  WriteLn;
  If Q1>Q2 then
  begin
   perestanovka (A,N,k,A1);
   WriteLn ('konechnay matrica');
   VYVOD (A1,N);
   WriteLn;
   FV (B,W,M);
   VYVOD_Vec (W,N);
  end
  else
  begin
   perestanovka (B,M,k,B1);
   WriteLn ('konechnay matrica');
   VYVOD (B1,M);
   WriteLn;
   FV (A,W,N);
   VYVOD_Vec (W,N);
  end;
  WriteLn ('Enter');
  ReadLn;
 end;
end.

Успехов!
 
огромное Вам спасибо!!! Насчет Var я и вправду не разобрался, теперь все понял,
Единственное, что я не понял, так это как работает Procedure perestanovka .. что там за индексы новые появились и почему мы дублеру присваиваем такое странное значение dub:=1000000.0;
 
citrus написал(а):
огромное Вам спасибо!!! Насчет Var я и вправду не разобрался, теперь все понял,
Единственное, что я не понял, так это как работает Procedure perestanovka .. что там за индексы новые появились и почему мы дублеру присваиваем такое странное значение dub:=1000000.0;
Нажмите для раскрытия...

Ну давайте разбираться.
Код: 
Procedure perestanovka (x:mas; C,z:Byte; var y:mas);
 Var i,j,m,Jfix:Byte;
     dub:real;
     v:Vec;
 Begin
  For j:=1 to C do
   v[j]:=x[z,j];
  For m:=1 to C do
   begin
    dub:=1000000.0;
    For j:=1 to C do
     if v[j]<dub then
      begin
       dub:=v[j];
       Jfix:=j;
      end;
    v[Jfix]:=1000000.0;
    For i:=1 to C do
     y[i,m]:=x[i,Jfix];
   end;
 End;

Прежде всего, введена новая матрица "у", которая получается из старой "х" после завершения всех перестановок, как результат работы процедуры.
Вводится вспомогательный вектор v, куда вначале копируется выбранная строка матрицы х. Далее нам надо С раз найти минимальное значение компонентов вектора v, при этом каждый раз исключая результат предыдущего поиска. Это делается в цикле по m. Алгоритм перестановок такой:
Параметру dub присваивается некое очень большое значение (например, 1000000.0). Используется стандартный алгоритм поиска минимума, т.е. для каждого компонента вектора v проверяется выполнение условия v[j]<dub, и если условие выполнено, то параметру dub присваивается значение v[j], а номер j сохраняется путем операции Jfix:=j. Таким образом, в результате цикла по j мы находим номер наименьшего из компонентов вектора v, равный Jfix. Чтобы исключить найденный минимальный компонент из поиска при проведении следующего цикла (поиска следующего по величине компонента v), значение найденного минимального компонента в векторе v заменяется опять же очень большим числом 1000000.0.
Далее копируем столбец матрицы х с найденным номером Jfix в столбец новой матрицы у с номером m.
Процедура повторяется С раз.
P.S. Идентификатор dub я использовал просто потому, что был такой у Вас. Лучше бы, конечно, переименовать его в Min.
P.P.S. Да, и булевскую переменную Fl можно убрать - она не используется.
 
Vladimir_S
спасибо большое, но ксати у меня получилось сделать это без дополнительного вектора, что тоже правильно))

теперь проблема в другом, не совсем корректно работает вот эта часть программы

HTML: 
Function Up (x:mas; C:Byte):Real;
 Var i,j,T:byte;
     Fl:boolean;
Begin
 T:=0;
 For i:=1 to C do
  begin
   Fl:=true;
   For j:=1 to C-1 do
    If x[i,j]<x[i,j+1] then Fl:=false;
   if Fl then  T:=T+1;
  end;
 Up:=T;
End;

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

Вложения

  • TIP.zip
    TIP.zip
    1.1 KB · Просмотры: 9
citrus написал(а):
теперь проблема в другом, не совсем корректно работает вот эта часть программы

HTML: 
Function Up (x:mas; C:Byte):Real;
 Var i,j,T:byte;
     Fl:boolean;
Begin
 T:=0;
 For i:=1 to C do
  begin
   Fl:=true;
   For j:=1 to C-1 do
    If x[i,j]<x[i,j+1] then Fl:=false;
   if Fl then  T:=T+1;
  end;
 Up:=T;
End;

тут же через досрочный выход нужно..я сделал, а он некорректно считает кол-во упорядоченных в первой матрице..почему-то еще прибавляет лишнее туда.
Нажмите для раскрытия...

Так, давайте расставим точки над i. Вы привели текст моей функции, которая, уверяю Вас, работает вполне корректно и ничего лишнего не добавляет. Теперь рассмотрим Ваш вариант:
Код: 
Function Up (  x:mas; C:Byte):real;
     Var i,j,T:byte;
          Fl:boolean;
        Begin
        T:=0;
        i:=1;
          Fl:=true;
        While (i<=C) and (Fl) do
        begin
            j:=1;
        While (j<=C-1) and (Fl) do
        begin
        If x[i,j]>x[i,j+1] then
        begin
        T:=T+1;
        j:=j+1;
        end
        else Fl:=false
        end;
        i:=i+1;
        end;
        Up:=T;
        end;
Ошибка в том, что Вы затолкали операцию T:=T+1 внутрь цикла по элементам строки, а надо в цикл по строкам, т.е. значение Т должно увеличиваться, только если ВСЯ СТРОКА упорядочена, а не пара соседних элементов. Исправляйте.
P.S. А что, обязательно нужно было прерывание цикла организовывать? Просто иногда есть смысл допустить выполнение лишних операций ради упрощения алгоритма. На современных компьютерах это не имеет большого значения.
 
Vladimir_S написал(а):
P.S. А что, обязательно нужно было прерывание цикла организовывать? Просто иногда есть смысл допустить выполнение лишних операций ради упрощения алгоритма. На современных компьютерах это не имеет большого значения.
Нажмите для раскрытия...

Во-первых, огромнешее Вам спасибо! безумно помогли и выручили меня, разообрался во всем.)

Насчет досрочного выхода..как нам говорят "С точки зрения программириования нужно делать все наиболее рационально и эффективно." поэтому требуют досрочный выход из циклов.

А не могли бы Вы сказать, как с паскаля скопировать текст в ворд например, и наоборот?
 
citrus написал(а):
Во-первых, огромнешее Вам спасибо!
Нажмите для раскрытия...
Пожалуйста.
А не могли бы Вы сказать, как с паскаля скопировать текст в ворд например, и наоборот?
Нажмите для раскрытия...
Да очень просто - открыть *.pas файл тем же Вордом. Он это вполне позволяет. Обратно - тоже просто: набрав текст программы в Ворде, сохраняете его в формате "только текст" (или "текст с форматированием") и потом переименовываете, точнее меняете расширение с *.txt на *pas.
 
Войдите или зарегистрируйтесь для ответа.
Назад
Сверху