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

citrus · 10.12.2009, 21:20

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

Vladimir_S · 10.12.2009, 23:10

Так, ну отладил я Вашу программу. Ошибок очень много, но ничего страшного, научитесь. Пара замечаний общего характера:
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.

Успехов!

citrus · 11.12.2009, 00:06

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

Vladimir_S · 11.12.2009, 10:10

Цитата:

Сообщение от 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 можно убрать - она не используется.

citrus · 17.12.2009, 19:49

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;

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

citrus · 17.12.2009, 19:57

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

Vladimir_S · 17.12.2009, 21:28

Цитата:

Сообщение от 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. А что, обязательно нужно было прерывание цикла организовывать? Просто иногда есть смысл допустить выполнение лишних операций ради упрощения алгоритма. На современных компьютерах это не имеет большого значения.

citrus · 17.12.2009, 22:10

Цитата:

Сообщение от Vladimir_S

P.S. А что, обязательно нужно было прерывание цикла организовывать? Просто иногда есть смысл допустить выполнение лишних операций ради упрощения алгоритма. На современных компьютерах это не имеет большого значения.

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

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

А не могли бы Вы сказать, как с паскаля скопировать текст в ворд например, и наоборот?

Vladimir_S · 17.12.2009, 22:17

Цитата:

Сообщение от citrus

Во-первых, огромнешее Вам спасибо!

Пожалуйста.

Цитата:

А не могли бы Вы сказать, как с паскаля скопировать текст в ворд например, и наоборот?

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

17.12.2009, 19:49	#25 (permalink)
citrus Member Регистрация: 29.09.2009 Сообщений: 32 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	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; тут же через досрочный выход нужно..я сделал, а он некорректно считает кол-во упорядоченных в первой матрице..почему-то еще прибавляет лишнее туда.

Опции темы
Версия для печати Отправить по электронной почте
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

11.12.2009, 00:06	#23 (permalink)
citrus Member Регистрация: 29.09.2009 Сообщений: 32 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	огромное Вам спасибо!!! Насчет Var я и вправду не разобрался, теперь все понял, Единственное, что я не понял, так это как работает Procedure perestanovka .. что там за индексы новые появились и почему мы дублеру присваиваем такое странное значение dub:=1000000.0;

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070