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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 24.12.2009, 20:19   #1
pasha92
Пользователь
 
Регистрация: 16.11.2009
Сообщений: 10
Восклицание Матрицы. ОЧЕНЬ ВАЖНО !!! Не могу найти ошибку в коде

Пожалуйста, помогите найти ошибку в выделении памяти. Задача:
Дана квадратная матрица A порядка n. Получить матрицу (А-С)^2+Е, где E – единичная матрица порядка n, а элементы матрицы C вычисляются по формуле c[i,j] = 1/(i+j) . Вот мои наработки:
Код:
program DinamicMatrix;
uses Crt;
type
        TArrElem = integer;
        TDVector = ^TVector;
        TVector = array[1..1] of TArrElem;
        TDMatrix = ^TMatrix;
        TMatrix = array[1..1] of TDVector;
var
        matrix_A: TDMatrix;
        matrix_C: TDMatrix;
        matrix_E: TDMatrix;
        sizeOfMatr: integer;
        fileWithMx: text;
        i, j : integer;

//начало или продолжение программы
procedure ExitOrContinue;

begin
        repeat
                case readkey of
                'Y', 'y', 'Ќ', '*' : break;
                'N', 'n', '’', 'в' : halt
                        else writeln ('Неверный ввод, повторите');
                end;

        until (false);
end;

//проверяет правильность пути к файлу
procedure CheckingPathOfFile (var f: text);
var
        fileName: string;
begin
        repeat
                writeln ('введите имя входного файла');
                readln (fileName);
                assign (f, fileName);
                {$I-}
                reset (f);
                {$I+}
                if IOResult = 0 then
                begin
                        close (f);
                        break;
                end
                else
                        writeln ('невозможно открыть файл, попытайтесь снова');
        until false;
end;

//проверяет правильность типа элементов файла
function CheckingElementsOfMatrix (var f: text) : integer;
begin
        {$I-}
        read (f, CheckingElementsOfMatrix);
        {$I+}
        if IOResult <> 0 then
        begin
                writeln ('найден элемент матрицы, который не является целым числом');
                writeln ('Укажите другой файл');
                CheckingPathOfFile (f);
        end;
end;

//возвращает размер матрицы
function funcSizeOfMatrix (var f: text) : integer;
var
        i: integer;
begin
        reset (f);
        funcSizeOfMatrix := 0;
        for i := 1 to maxInt do
        begin
                CheckingElementsOfMatrix (f);
                inc (funcSizeOfMatrix);
                if SeekEOF (f) then
                break;
        end;
        if int (sqrt (funcSizeOfMatrix)) <> (funcSizeOfMatrix / sqrt (funcSizeOfMatrix)) then
        begin
                writeln ('неверный размер матрицы);
                writeln (''Укажите другой файл'');
                CheckingPathOfFile (f);
        end
        else
                funcSizeOfMatrix := round (sqrt (funcSizeOfMatrix));
end;

procedure MyGetMem (var p: pointer; sizeMem: integer);
begin
        sizeMem := (sizeMem div 16) shl 4;
        GetMem (p, sizeMem);
        if p = nil then
        exit;
end;

procedure MyFreeMem (var p: pointer; sizeMem: integer);
begin
        sizeMem := (sizeMem div 16) shl 4;
        FreeMem (p, sizeMem);
end;

procedure GetMemoryForMatrix (var Mx: TDMatrix; var f: text; sizeOfMx: integer);

begin
        sizeOfMx := funcSizeOfMatrix (f);
        MyGetMem (Mx, sizeOfMx * sizeOf (TDVector));
        for j := 1 to SizeOfMx do
                MyGetMem (Mx^[j], sizeOfMx * sizeOf (TArrElem));
end;

procedure FreeMemoryForMatrix (var Mx: TDMatrix; var f: text; sizeOfMx: integer);

begin
        sizeOfMx := funcSizeOfMatrix (f);
        for j := 1 to SizeOfMx do
                MyFreeMem (Mx^[j], sizeOfMx * sizeOf (TArrElem));
        MyFreeMem (Mx, sizeOfMx * sizeOf (TDVector));
end;

procedure PrintMatrix (var Mx: TDMatrix; var f : text; sizeOfMx: integer);
var
        i, j: integer;
begin
        reset (f);
        sizeOfMx := funcSizeOfMatrix (f);
        for i := 1 to SizeOfMx do
                for j := 1 to SizeOfMx do
                begin
                        Mx^[i]^[j] := CheckingElementsOfMatrix (f);
                        write (Mx^[i]^[j] : 5);
                end;
                writeln;
end;
BEGIN
        {$R-}
        ReturnNilIfGrowHeapFails:= TRUE;
        clrscr;
        writeln ('нажмите Y для начала, N - для выхода ');
        ExitOrContinue;
        CheckingPathOfFile (fileWithMx);
        GetMemoryForMatrix (matrix_A, fileWithMx, sizeOfMatr);
        PrintMatrix (matrix_A, fileWithMx, sizeOfMatr);
        FreeMemoryForMatrix (matrix_A, fileWithMx, sizeOfMatr);
END.
pasha92 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно найти ошибку в коде Вован111 Помощь студентам 15 08.11.2009 14:33
не могу найти ошибку в коде pavelstraut Общие вопросы C/C++ 5 24.07.2009 23:20
Не могу найти ошибку в коде! Natasha666 Помощь студентам 1 20.05.2009 09:27
Помогите найти ошибку, очень важно!!! d3lm1kk Помощь студентам 3 14.10.2008 02:46
формирование матрицы (задание выполненно не могу найти сваю ошибку) КиношкА Помощь студентам 7 11.01.2008 03:50