Форум программистов
 
Расширенный поиск
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Новички в программировании > Помощь студентам
Регистрация

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



Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Название темы включает слова - "Помогите", "Спасите", "Срочно"
Название темы не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте >>>правила <<< и заново правильно создайте тему.
 
Опции темы
Старый 11.10.2010, 12:09   #11
8ball
Пользователь
 
Аватар для 8ball
 
Регистрация: 04.10.2010
Адрес: Екатеринбург(Пионерский микрорайон)
Сообщений: 11
Репутация: 10

icq: 429582397
skype: meahael
По умолчанию

кто нибудь знает как осуществить ввод матрицы с клавиатуры в паскале
8ball вне форума  
Старый 12.10.2010, 18:01   #12
psycho-coder
Профессионал
 
Аватар для psycho-coder
 
Регистрация: 06.04.2009
Сообщений: 1,524
Репутация: 343
По умолчанию

Код не проверял
Код:

const
  N = 10;
  M = 10;
var
  i, j: Integer;
  arr: array [0..N, 0..M] of Byte;
begin
  for i := 0 to N do
    for j := 0 to M do
	begin
	  Write('Enter ', i, ',', j, ': ');
	  ReadLn(arr[i, j]);
	end;
end;


Последний раз редактировалось psycho-coder; 13.10.2010 в 09:26.
psycho-coder вне форума  
Старый 15.10.2010, 20:01   #13
Sandrewz
Новичок
 
Регистрация: 15.10.2010
Сообщений: 3
Репутация: 10
По умолчанию

а как найти несколько максимальных чисел?! в матрице
Sandrewz вне форума  
Старый 15.10.2010, 20:09   #14
psycho-coder
Профессионал
 
Аватар для psycho-coder
 
Регистрация: 06.04.2009
Сообщений: 1,524
Репутация: 343
По умолчанию

Есть два способа:
1) Сделать копию массива (или не делать), отсортировать по убыванию и брать первые элементы.
2) Выписывать максимальные числа в отдельный массив, и брать последние элементы.
psycho-coder вне форума  
Старый 23.10.2010, 14:56   #15
ex.cluz
Профессионал
 
Аватар для ex.cluz
 
Регистрация: 15.01.2010
Адрес: Подмосковье
Сообщений: 1,325
Репутация: 387
По умолчанию

Когда-то нашел на просторах Инета модуль для работы с матрицами, который использовал в своей программе по статистической обработке данных. Я его не модифицировал и ничего не добавлял, т.к. он и так хорош (операции выполняются быстрее, чем с Дельфийскими массивами). Может, кому-то будет полезен.
Код:

Unit Matrix; 

interface 

type 
  MatrixPtr = ^MatrixRec; 
  MatrixRec = record 
    MatrixRow   : byte; 
    MatrixCol   : byte; 
    MatrixArray : pointer; 
  end; 
  MatrixElement = real; 

(* Функция возвращает целочисленную степень *) 
function IntPower(X,n : integer) : integer; 

(* Функция создает квадратную матрицу *) 
function  CreateSquareMatrix(Size : byte) : MatrixPtr; 

(* Функция создает прямоугольную матрицу *) 
function  CreateMatrix(Row,Col : byte) : MatrixPtr; 

(* Функция дублирует матрицу *) 
function  CloneMatrix(MPtr : MatrixPtr) : MatrixPtr; 

(* Функция удаляет матрицу и возвращает TRUE в случае удачи *) 
function  DeleteMatrix(var MPtr : MatrixPtr) : boolean; 

(* Функция заполняет матрицу указанным числом *) 
function  FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) : boolean; 

(* Функция удаляет матрицу MPtr1 и присваивает ей значение MPtr2 *) 
function  AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr) : MatrixPtr; 

(* Функция отображает матрицу на консоль *) 
function  DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) : boolean; 

(* Функция возвращает TRUE, если матрица 1x1 *) 
function  IsSingleMatrix(MPtr : MatrixPtr) : boolean; 

(* Функция возвращает TRUE, если матрица квадратная *) 
function  IsSquareMatrix(MPtr : MatrixPtr) : boolean; 

(* Функция возвращает количество строк матрицы *) 
function  GetMatrixRow(MPtr : MatrixPtr) : byte; 

(* Функция возвращает количество столбцов матрицы *) 
function  GetMatrixCol(MPtr : MatrixPtr) : byte; 

(* Процедура устанавливает элемент матрицы *) 
procedure SetMatrixElement(MPtr : MatrixPtr;Row,Col : byte;Value : MatrixElement); 

(* Функция возвращает элемент матрицы *) 
function  GetMatrixElement(MPtr : MatrixPtr;Row,Col : byte) : MatrixElement; 

(* Функция исключает векторы из матрицы *) 
function  ExcludeVectorFromMatrix(MPtr : MatrixPtr;Row,Col : byte) : MatrixPtr; 

(* Функция заменяет строку(столбец) матрицы вектором *) 
function  SetVectorIntoMatrix(MPtr,VPtr : MatrixPtr;_Pos : byte) : MatrixPtr; 

(* Функция возвращает детерминант матрицы *) 
function  DetMatrix(MPtr : MatrixPtr) : MatrixElement; 

(* Функция возвращает детерминант треугольной матрицы *) 
function  DetTriangularMatrix(MPtr : MatrixPtr) : MatrixElement; 

(* Функция возвращает алгебраическое дополнение элемента матрицы *) 
function  AppendixElement(MPtr : MatrixPtr;Row,Col : byte) : MatrixElement; 

(* Функция создает матрицу алгебраических дополнений элементов матрицы *) 
function  CreateAppendixMatrix(MPtr : MatrixPtr) : MatrixPtr; 

(* Функция транспонирует матрицу *) 
function TransponeMatrix(MPtr : MatrixPtr) : MatrixPtr; 

(* Функция возвращает обратную матрицу *) 
function ReverseMatrix(MPtr : MatrixPtr) : MatrixPtr; 

(* Функция умножает матрицу на число *) 
function MultipleMatrixOnNumber(MPtr : MatrixPtr;Number : MatrixElement) : MatrixPtr; 

(* Функция умножает матрицу на матрицу *) 
function MultipleMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 

(* Функция суммирует две матрицы *) 
function AddMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 

(* Функция вычитает из первой матрицы вторую *) 
function SubMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 

(* Функция решает систему методом Гаусса и возвращает LU-матрицы *) 
(* Результат функции - вектор-столбец решений                    *) 

function GausseMethodMatrix(MPtr,VPtr : MatrixPtr;var LPtr,UPtr,BPtr : MatrixPtr) : MatrixPtr; 


implementation 


function IntPower(X,n : integer) : integer; 
var 
 Res,i : integer; 
begin 
 if n < 1 then IntPower:= 0 
 else begin 
   Res:= X; 
   for i:=1 to n-1 do Res:= Res*X; 
   IntPower:= Res; 
 end; 
end;

__________________
Грибы - они разные. Один тебя накормит, другой тебе кино покажет...
Редактор журнала "
[ПРОграммист]"
Yan's Home Digital Lab
ex.cluz вне форума  
Старый 23.10.2010, 14:56   #16
ex.cluz
Профессионал
 
Аватар для ex.cluz
 
Регистрация: 15.01.2010
Адрес: Подмосковье
Сообщений: 1,325
Репутация: 387
По умолчанию

Код:

function CreateSquareMatrix(Size : byte) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
begin 
 TempPtr:= nil; 
 GetMem(TempPtr,SizeOf(MatrixRec)); 
 if TempPtr = nil then begin 
   CreateSquareMatrix:= nil; 
   Exit; 
 end; 
 with TempPtr^ do begin 
   MatrixRow:= Size; 
   MatrixCol:= Size; 
   MatrixArray:= nil; 
   GetMem(MatrixArray,Size*Size*SizeOf(MatrixElement)); 
   if MatrixArray = nil then begin 
     FreeMem(TempPtr,SizeOf(MatrixRec)); 
     CreateSquareMatrix:= nil; 
     Exit; 
   end; 
 end; 
 FillMatrix(TempPtr,0); 
 CreateSquareMatrix:= TempPtr; 
end; 


function CreateMatrix(Row,Col : byte) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
begin 
 TempPtr:= nil; 
 GetMem(TempPtr,SizeOf(MatrixRec)); 
 if TempPtr = nil then begin 
   CreateMatrix:= nil; 
   Exit; 
 end; 
 with TempPtr^ do begin 
   MatrixRow:= Row; 
   MatrixCol:= Col; 
   MatrixArray:= nil; 
   GetMem(MatrixArray,Row*Col*SizeOf(MatrixElement)); 
   if MatrixArray = nil then begin 
     FreeMem(TempPtr,SizeOf(MatrixRec)); 
     CreateMatrix:= nil; 
     Exit; 
   end; 
 end; 
 FillMatrix(TempPtr,0); 
 CreateMatrix:= TempPtr; 
end; 


function DeleteMatrix(var MPtr : MatrixPtr) : boolean; 
begin 
 if MPtr = nil then DeleteMatrix:= FALSE 
 else with MPtr^ do begin 
   if MatrixArray <> nil then 
     FreeMem(MatrixArray,MatrixRow*MatrixCol*SizeOf(MatrixElement)); 
   FreeMem(MPtr,SizeOf(MatrixRec)); 
   MPtr:= nil; 
   DeleteMatrix:= TRUE; 
 end; 
end; 


function CloneMatrix(MPtr : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j     : byte; 
begin 
 if MPtr = nil then CloneMatrix:= nil 
 else with MPtr^ do begin 
   TempPtr:= CreateMatrix(MPtr^.MatrixRow,MPtr^.MatrixCol); 
   if TempPtr <> nil then begin 
     for i:= 1 to MatrixRow do 
       for j:= 1 to MatrixCol do 
         SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr,i,j)); 
     CloneMatrix:= TempPtr; 
   end else CloneMatrix:= nil; 
 end; 
end; 



function FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) : boolean; 
var 
 i,j : byte; 
begin 
 if MPtr = nil then FillMatrix:= FALSE 
 else with MPtr^ do begin 
   for i:= 1 to MatrixRow do 
     for j:= 1 to MatrixCol do 
       SetMatrixElement(MPtr,i,j,Value); 
   FillMatrix:= TRUE; 
 end; 
end; 


function AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr) : MatrixPtr; 
begin 
 DeleteMatrix(MPtr1); 
 MPtr1:= MPtr2; 
 AssignMatrix:= MPtr1; 
end; 


function DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) : boolean; 
var 
 i,j : byte; 
begin 
 if MPtr = nil then DisplayMatrix:= FALSE 
 else with MPtr^ do begin 
   for i:= 1 to MatrixRow do begin 
     for j:= 1 to MatrixCol do 
       write(GetMatrixElement(MPtr,i,j) : _Int : _Frac); 
     writeln; 
   end; 
   DisplayMatrix:= TRUE; 
 end; 
end; 


function IsSingleMatrix(MPtr : MatrixPtr) : boolean; 
begin 
 if MPtr <> nil then with MPtr^ do begin 
   if (MatrixRow = 1) and (MatrixCol = 1) then 
     IsSingleMatrix:= TRUE 
   else IsSingleMatrix:= FALSE; 
 end else IsSingleMatrix:= FALSE; 
end; 


function IsSquareMatrix(MPtr : MatrixPtr) : boolean; 
begin 
 if MPtr <> nil then with MPtr^ do begin 
   if MatrixRow = MatrixCol then 
     IsSquareMatrix:= TRUE 
   else IsSquareMatrix:= FALSE; 
 end else IsSquareMatrix:= FALSE; 
end; 

function GetMatrixRow(MPtr : MatrixPtr) : byte; 
begin 
 if MPtr <> nil then GetMatrixRow:= MPtr^.MatrixRow 
 else GetMatrixRow:= 0; 
end; 

function GetMatrixCol(MPtr : MatrixPtr) : byte; 
begin 
 if MPtr <> nil then GetMatrixCol:= MPtr^.MatrixCol 
 else GetMatrixCol:= 0; 
end;

__________________
Грибы - они разные. Один тебя накормит, другой тебе кино покажет...
Редактор журнала "
[ПРОграммист]"
Yan's Home Digital Lab
ex.cluz вне форума  
Старый 23.10.2010, 14:57   #17
ex.cluz
Профессионал
 
Аватар для ex.cluz
 
Регистрация: 15.01.2010
Адрес: Подмосковье
Сообщений: 1,325
Репутация: 387
По умолчанию

Код:

procedure SetMatrixElement(MPtr : MatrixPtr;Row,Col : byte;Value : MatrixElement); 
var 
 TempPtr : ^MatrixElement; 
begin 
 if MPtr <> nil then 
   if (Row <> 0) or (Col <> 0) then with MPtr^ do begin 
     pointer(TempPtr):= pointer(MatrixArray); 
     Inc(TempPtr,MatrixRow*(Col-1)+Row-1); 
     TempPtr^:= Value; 
   end; 
end; 


function GetMatrixElement(MPtr : MatrixPtr;Row,Col : byte) : MatrixElement; 
var 
 TempPtr : ^MatrixElement; 
begin 
 if MPtr <> nil then begin 
   if (Row <> 0) and (Col <> 0) then with MPtr^ do begin 
     pointer(TempPtr):= pointer(MatrixArray); 
     Inc(TempPtr,MatrixRow*(Col-1)+Row-1); 
     GetMatrixElement:= TempPtr^; 
   end else GetMatrixElement:= 0; 
 end else GetMatrixElement:= 0; 
end; 


function ExcludeVectorFromMatrix(MPtr : MatrixPtr;Row,Col : byte) : MatrixPtr; 
var 
 NewPtr           : MatrixPtr; 
 NewRow, NewCol   : byte; 
 i,j              : byte; 
 DiffRow, DiffCol : byte; 
begin 
 if MPtr <> nil then with MPtr^ do begin 

   if Row = 0 then NewRow:= MatrixRow 
   else NewRow:= MatrixRow-1; 
   if Col = 0 then NewCol:= MatrixCol 
   else NewCol:= MatrixCol-1; 

   NewPtr:= CreateMatrix(NewRow, NewCol); 
   if (NewPtr = nil) or (NewPtr^.MatrixArray = nil) then begin 
     ExcludeVectorFromMatrix:= nil; 
     Exit; 
   end; 

   DiffRow:= 0; 
   DiffCol:= 0; 
   for i:= 1 to MatrixRow do begin 
     if i = Row then DiffRow:= 1 
     else  for j:= 1 to MatrixCol do if j = Col then DiffCol:= 1 
       else SetMatrixElement(NewPtr,i-DiffRow,j-DiffCol, 
         GetMatrixElement(MPtr,i,j)); 
     DiffCol:= 0; 
   end; 

   ExcludeVectorFromMatrix:= NewPtr; 
 end else ExcludeVectorFromMatrix:= nil; 
end; 


function SetVectorIntoMatrix(MPtr,VPtr : MatrixPtr;_Pos : byte) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i       : byte; 
begin 
 if (MPtr <> nil) and (VPtr <> nil) then begin 
   TempPtr:= CloneMatrix(MPtr); 
   if TempPtr = nil then begin 
     SetVectorIntoMatrix:= nil; 
     Exit; 
   end; 
   if VPtr^.MatrixRow = 1 then begin 
     for i:= 1 to TempPtr^.MatrixCol do 
       SetMatrixElement(TempPtr,_Pos,i,GetMatrixElement(VPtr,1,i)); 
   end else begin 
     for i:= 1 to TempPtr^.MatrixRow do 
       SetMatrixElement(TempPtr,i,_Pos,GetMatrixElement(VPtr,i,1)); 
   end; 
   SetVectorIntoMatrix:= TempPtr; 
 end else SetVectorIntoMatrix:= nil; 
end; 


function DetMatrix(MPtr : MatrixPtr) : MatrixElement; 
var 
 TempPtr : MatrixPtr; 
 i,j     : byte; 
 Sum     : MatrixElement; 
begin 
 if IsSquareMatrix(MPtr) then begin 
   if not IsSingleMatrix(MPtr) then begin 
     TempPtr:= nil; 
     Sum:= 0; 
     for j:= 1 to GetMatrixCol(MPtr) do begin 
       AssignMatrix(TempPtr,ExcludeVectorFromMatrix(MPtr,1,j)); 
       Sum:= Sum+IntPower(-1,j+1)*GetMatrixElement(MPtr,1,j)*DetMatrix(TempPtr); 
     end; 
     DeleteMatrix(TempPtr); 
     DetMatrix:= Sum; 
   end else DetMatrix:= GetMatrixElement(MPtr,1,1); 
 end else DetMatrix:= 0; 
end; 


function DetTriangularMatrix(MPtr : MatrixPtr) : MatrixElement; 
var 
 i       : byte; 
 Sum     : MatrixElement; 
begin 
 if IsSquareMatrix(MPtr) then begin 
   Sum:= 1; 
   for i:= 1 to MPtr^.MatrixRow do 
     Sum:= Sum*GetMatrixElement(MPtr,i,i); 
   DetTriangularMatrix:= Sum; 
 end else DetTriangularMatrix:= 0; 
end; 


function AppendixElement(MPtr : MatrixPtr;Row,Col : byte) : MatrixElement; 
var 
 TempPtr : MatrixPtr; 
begin 
 if IsSquareMatrix(MPtr) then begin 
   TempPtr:= ExcludeVectorFromMatrix(MPtr,Row,Col); 
   if TempPtr = nil then begin 
     AppendixElement:= 0; 
     Exit; 
   end; 
   AppendixElement:= IntPower(-1,Row+Col)*DetMatrix(TempPtr); 
   DeleteMatrix(TempPtr); 
 end else AppendixElement:= 0; 
end;

__________________
Грибы - они разные. Один тебя накормит, другой тебе кино покажет...
Редактор журнала "
[ПРОграммист]"
Yan's Home Digital Lab
ex.cluz вне форума  
Старый 23.10.2010, 14:58   #18
ex.cluz
Профессионал
 
Аватар для ex.cluz
 
Регистрация: 15.01.2010
Адрес: Подмосковье
Сообщений: 1,325
Репутация: 387
По умолчанию

Код:

function CreateAppendixMatrix(MPtr : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j     : byte; 
begin 
 if (MPtr <> nil) or (MPtr^.MatrixArray <> nil) or 
    (not IsSquareMatrix(MPtr)) then with MPtr^ do begin 
   TempPtr:= CreateMatrix(MatrixCol,MatrixRow); 
   for i:= 1 to MatrixRow do 
     for j:= 1 to MatrixCol do 
       SetMatrixElement(TempPtr,i,j,AppendixElement(MPtr,i,j)); 
   CreateAppendixMatrix:= TempPtr; 
 end else CreateAppendixMatrix:= nil; 
end; 



function TransponeMatrix(MPtr : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j     : byte; 
begin 
 if (MPtr <> nil) or (MPtr^.MatrixArray <> nil) then with MPtr^ do begin 
   TempPtr:= CreateMatrix(MatrixCol,MatrixRow); 
   for i:= 1 to MatrixRow do 
     for j:= 1 to MatrixCol do 
       SetMatrixElement(TempPtr,j,i,GetMatrixElement(MPtr,i,j)); 
   TransponeMatrix:= TempPtr; 
 end else TransponeMatrix:= nil; 
end; 


function ReverseMatrix(MPtr : MatrixPtr) : MatrixPtr; 
var 
 TempPtr     : MatrixPtr; 
 Determinant : MatrixElement; 
begin 
 if MPtr <> nil then begin 
   TempPtr:= nil; 
   AssignMatrix(TempPtr,CreateAppendixMatrix(MPtr)); 
   AssignMatrix(TempPtr,TransponeMatrix(TempPtr)); 
   Determinant:= DetMatrix(MPtr); 
   if (TempPtr = nil) or (Determinant = 0) then begin 
     DeleteMatrix(TempPtr); 
     ReverseMatrix:= nil; 
     Exit; 
   end; 
   AssignMatrix(TempPtr,MultipleMatrixOnNumber(TempPtr,1/Determinant)); 
   ReverseMatrix:= TempPtr; 
 end else ReverseMatrix:= nil; 
end; 



function MultipleMatrixOnNumber(MPtr : MatrixPtr;Number : MatrixElement) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j     : byte; 
begin 
 if MPtr <> nil then with MPtr^ do begin 
   TempPtr:= CreateMatrix(MatrixRow,MatrixCol); 
   if TempPtr = nil then begin 
     MultipleMatrixOnNumber:= nil; 
     Exit; 
   end; 
   for i:= 1 to MatrixRow do 
     for j:= 1 to MatrixCol do 
       SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr,i,j)*Number); 
   MultipleMatrixOnNumber:= TempPtr; 
 end else MultipleMatrixOnNumber:= nil; 
end; 


function MultipleMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j,k   : byte; 
begin 
 if (MPtr1 <>  nil) and (MPtr2 <> nil) then begin 
   TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol); 
   if TempPtr = nil then begin 
     MultipleMatrixOnMatrix:= nil; 
     Exit; 
   end; 
   for i:= 1 to TempPtr^.MatrixRow do 
     for j:= 1 to TempPtr^.MatrixCol do 
       for k:= 1 to MPtr1^.MatrixCol do 
         SetMatrixElement(TempPtr,i,j,GetMatrixElement(TempPtr,i,j)+ 
           GetMatrixElement(MPtr1,i,k)*GetMatrixElement(MPtr2,k,j)); 
   MultipleMatrixOnMatrix:= TempPtr; 
 end else MultipleMatrixOnMatrix:= nil; 
end;

__________________
Грибы - они разные. Один тебя накормит, другой тебе кино покажет...
Редактор журнала "
[ПРОграммист]"
Yan's Home Digital Lab
ex.cluz вне форума  
Старый 23.10.2010, 14:59   #19
ex.cluz
Профессионал
 
Аватар для ex.cluz
 
Регистрация: 15.01.2010
Адрес: Подмосковье
Сообщений: 1,325
Репутация: 387
По умолчанию

И последняя часть модуля:

Код:

function AddMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j,k   : byte; 
begin 
 if (MPtr1 <>  nil) and (MPtr2 <> nil) then begin 
   TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol); 
   if TempPtr = nil then begin 
     AddMatrixOnMatrix:= nil; 
     Exit; 
   end; 
   for i:= 1 to TempPtr^.MatrixRow do 
     for j:= 1 to TempPtr^.MatrixCol do 
       SetMatrixElement(TempPtr,i,j,GetMatrixElement(Mptr1,i,j)+ 
         GetMatrixElement(MPtr2,i,j)); 
   AddMatrixOnMatrix:= TempPtr; 
 end else AddMatrixOnMatrix:= nil; 
end; 


function SubMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) : MatrixPtr; 
var 
 TempPtr : MatrixPtr; 
 i,j,k   : byte; 
begin 
 if (MPtr1 <>  nil) and (MPtr2 <> nil) then begin 
   TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol); 
   if TempPtr = nil then begin 
     SubMatrixOnMatrix:= nil; 
     Exit; 
   end; 
   for i:= 1 to TempPtr^.MatrixRow do 
     for j:= 1 to TempPtr^.MatrixCol do 
       SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr1,i,j)- 
         GetMatrixElement(MPtr2,i,j)); 
   SubMatrixOnMatrix:= TempPtr; 
 end else SubMatrixOnMatrix:= nil; 
end; 



function GausseMethodMatrix(MPtr,VPtr : MatrixPtr;var LPtr,UPtr,BPtr : MatrixPtr) : MatrixPtr; 
var 
 TempPtr  : MatrixPtr; 
 TempVPtr : MatrixPtr; 
 TempLPtr : MatrixPtr; 
 TempUPtr : MatrixPtr; 
 XSum     : MatrixElement; 
 i,j,k    : byte; 
begin 
 if (MPtr <> nil) and (VPtr <> nil) then begin 

   TempUPtr:= CloneMatrix(MPtr); 
   if TempUPtr = nil then begin 
     GausseMethodMatrix:= nil; 
     Exit; 
   end; 
   TempLPtr:= CreateMatrix(MPtr^.MatrixRow,MPtr^.MatrixCol); 
   if TempLPtr = nil then begin 
     DeleteMatrix(TempUPtr); 
     GausseMethodMatrix:= nil; 
     Exit; 
   end; 
   TempVPtr:= CloneMatrix(VPtr); 
   if TempVPtr = nil then begin 
     DeleteMatrix(TempLPtr); 
     DeleteMatrix(TempUPtr); 
     GausseMethodMatrix:= nil; 
     Exit; 
   end; 
   TempPtr:= CreateMatrix(MPtr^.MatrixRow,1); 
   if TempPtr = nil then begin 
     DeleteMatrix(TempVPtr); 
     DeleteMatrix(TempLPtr); 
     DeleteMatrix(TempUPtr); 
     GausseMethodMatrix:= nil; 
     Exit; 
   end; 

   for j:= 1 to MPtr^.MatrixCol-1 do begin 
     SetMatrixElement(TempLPtr,j,j,1); 
     for i:= j+1 to MPtr^.MatrixRow do begin 
       SetMatrixElement(TempLPtr,i,j,GetMatrixElement(TempUPtr,i,j)/ 
         GetMatrixElement(TempUPtr,j,j)); 
       for k:= j to MPtr^.MatrixCol do begin 
         SetMatrixElement(TempUPtr,i,k,GetMatrixElement(TempUPtr,i,k)- 
           GetMatrixElement(TempLPtr,i,j)*GetMatrixElement(TempUPtr,j,k)); 
       end; 
       SetMatrixElement(TempVPtr,i,1,GetMatrixElement(TempVPtr,i,1)- 
         GetMatrixElement(TempLPtr,i,j)*GetMatrixElement(TempVPtr,j,1)); 
     end; 
   end; 

   SetMatrixElement(TempLPtr,TempLPtr^.MatrixRow,TempLPtr^.MatrixCol,1); 
   SetMatrixElement(TempPtr,TempPtr^.MatrixRow,1, 
     GetMatrixElement(TempVPtr,TempVPtr^.MatrixRow,1)/ 
     GetMatrixElement(TempUPtr,TempUPtr^.MatrixRow,TempUPtr^.MatrixCol)); 

   for j:= MPtr^.MatrixCol-1 downto 1 do begin 
     XSum:= 0; 
     for k:= j+1 to MPtr^.MatrixCol do 
       XSum:= XSum+GetMatrixElement(TempUPtr,j,k)* 
         GetMatrixElement(TempPtr,k,1); 
     SetMatrixElement(TempPtr,j,1,(GetMatrixElement(TempVPtr,j,1)-XSum)/ 
       GetMatrixElement(TempUPtr,j,j)); 
   end; 

   LPtr:= TempLPtr; 
   UPtr:= TempUPtr; 
   BPtr:= TempVPtr; 
   GausseMethodMatrix:= TempPtr; 
 end else GausseMethodMatrix:= nil; 
end;

end.

__________________
Грибы - они разные. Один тебя накормит, другой тебе кино покажет...
Редактор журнала "
[ПРОграммист]"
Yan's Home Digital Lab
ex.cluz вне форума  
Старый 15.12.2010, 10:37   #20
Stilet
Белик Виталий :)
Профессионал
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Адрес: Украина, Донецкая область, г. Краматорск
Сообщений: 57,968
Репутация: 6787
По умолчанию

Дописываю:
Найти сумму элементов диагоналей, параллельных главной и отдельно проход по диагоналям параллельным побочной
Язык С
Код:

// ertert.cpp: определяет точку входа для консольного приложения.
//

#include "stdafx.h"
const int n=5,m=5;
	int a[n][m];

int СуммаЭлементовДиагоналиПаралельнойГлавной(int x,int y){
	int s=0;
	for(;x<n&&y<m;x++,y++){
		s+=a[x][y];
	}
	return s;
}
int СуммаЭлементовДиагоналиПаралельнойПобочной(int x,int y){
	int s=0;
	for(;x<n&&y<m;x--,y++){
		s+=a[x][y];
	}
	return s;
}
int _tmain(int argc, _TCHAR* argv[])
{
	

	for(int i=0;i<n;i++){
		for(int j=0;j<m;j++){
			a[i][j]=i+j;printf("%d\t",a[i][j]);
		}printf("\n");
	}printf("\n");
// Проход по диагоналям в верхнем треугольнике
	for(int i=0;i<m;i++)printf("%d\t",СуммаЭлементовДиагоналиПаралельнойГлавной(i,0));printf("\n");
// Проход по диагоналям в нижнем треугольнике
	for(int i=0;i<n;i++)printf("%d\t",СуммаЭлементовДиагоналиПаралельнойГлавной(0,i));printf("\n");
printf("\n");
// Проход по диагоналям в верхнем треугольнике
	for(int i=0;i<m;i++)printf("%d\t",СуммаЭлементовДиагоналиПаралельнойПобочной(i,0));printf("\n");
// Проход по диагоналям в нижнем треугольнике
	for(int i=0;i<n;i++)printf("%d\t",СуммаЭлементовДиагоналиПаралельнойПобочной(0,i));printf("\n");
	
	getchar();
    return 0;
}

__________________
I'm learning to live...
Stilet вне форума  
Закрытая тема



Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Теория вероятности. Решить 2 задачи Worldqwerty Помощь студентам 2 14.01.2013 14:52
Типичные задачи на С++ Heming Помощь студентам 3 15.10.2012 11:13
Теория языков программирования и проектирование компиляторов (задачи) Onni Помощь студентам 0 03.06.2012 21:18
Теория информации + теория её передачи. vedro-compota Свободное общение 4 23.10.2010 10:06
решение инженерных задач современными средствами компьютерной техники и типичные задачи автоматизированны Дініс Свободное общение 1 12.09.2009 00:02




13:57.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Покупайте на сайте www.skinon.ru уникальные чехлы и наклейки для телефонов.
купить трафик


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

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru