Вычисление ранга матрицы и ее числа обусловленности и определителя на Turbo Prolog

Вычисление ранга матрицы, ее числа обусловленности и определителя на Turbo Prolog.

NOWARNINGS
DOMAINS
integer_list = integer*
integer_matrix = integer_list*
integer_matrix_list = integer_matrix*
file = file_pointer
real_list = real*

PREDICATES
load_matrix(integer, integer, integer_matrix)
load_matrix_rows(integer, integer, integer_matrix)
read_row(integer, integer_list)
print_matrix(integer, integer, integer_matrix)
print_matrix_rows(integer_matrix)
print_row(integer_list)
wait_for_enter
process_file1
process_file2(integer, integer)
read_number(integer)

% Предикаты для определителя матрицы
determinant(integer_matrix, real)
get_minor(integer_matrix, integer, integer, integer_matrix)
remove_row(integer_matrix, integer, integer_matrix)
remove_column_from_matrix(integer_matrix, integer, integer_matrix)
remove_element(integer_list, integer, integer_list)
calculate_det(integer_matrix, integer_list, integer, real, real)
get_sign(integer, real)

% Предикаты для числа обусловленности
matrix_size(integer_matrix, integer)
frobenius_norm(integer_matrix, real)
condition_number_svd(integer_matrix, real)
condition_number(integer_matrix, real)
row_squared_sum(integer_list, real)
frobenius_norm_acc(integer_matrix, real, real)
check_norm(real, real)
calculate_2x2_singular_values(integer_matrix, real, real)
calculate_condition_from_singular_values(real, real, real)
safe_sqrt(real, real)
check_1x1(integer, real)

% Предикаты для ранга матрицы
matrix_rank(integer_matrix, integer)
find_matrix_rank(integer_matrix, integer)
find_rank(integer_matrix, integer, integer, integer)
has_any_nonzero_minor(integer_matrix, integer)
get_all_submatrices(integer_matrix, integer, integer_matrix_list)
get_kxk_submatrix(integer_matrix, integer, integer_matrix)
combination(integer, integer, integer_list)
comb(integer, integer_list, integer_list)
contains_nonzero_det(integer_matrix_list)
extract_submatrix(integer_matrix, integer_list, integer_list, integer_matrix)
extract_rows_by_indices(integer_matrix, integer_list, integer_matrix)
extract_columns_from_rows(integer_matrix, integer_list, integer_matrix)
extract_elements_by_indices(integer_list, integer_list, integer_list)
get_nth_row(integer_matrix, integer, integer_list)
get_nth_element(integer_list, integer, integer)
numlist(integer, integer_list)
numlist(integer, integer, integer_list)

% Базовые предикаты для работы с матрицами
get_first_column(integer_matrix, integer)
length_row(integer_list, integer)
get_min_dimension(integer, integer, integer)

CLAUSES
% Чтение числа
read_number(Number) :-
readint(Number), !.
read_number(Number) :-
write("Warning: Failed to read number, using 0"), nl,
Number = 0.

% Загрузка матрицы
load_matrix(Rows, Cols, Matrix) :-
load_matrix_rows(Rows, Cols, Matrix).

% Загрузка строк матрицы
load_matrix_rows(0, _, []) :- !.
load_matrix_rows(R, Cols, [Row | Rest]) :-
R > 0,
read_row(Cols, Row),
R1 = R - 1,
load_matrix_rows(R1, Cols, Rest).

% Чтение строки матрицы
read_row(0, []) :- !.
read_row(Cols, [H|T]) :-
Cols > 0,
read_number(H),
Cols1 = Cols - 1,
read_row(Cols1, T).

% Печать матрицы и ее размерности
print_matrix(Rows, Cols, Matrix) :-
write("=== MATRIX ==="), nl,
write("Dimensions: ", Rows, " x ", Cols), nl,
write("Elements:"), nl,
print_matrix_rows(Matrix).

% Печать строк матрицы
print_matrix_rows([]).
print_matrix_rows([Row|Rest]) :-
write(" "),
print_row(Row),
nl,
print_matrix_rows(Rest).

% Печать строки матрицы
print_row([]).
print_row([H]) :-
write(H), !.
print_row([H|T]) :-
write(H),
write(" "),
print_row(T).

% ================ ОПРЕДЕЛИТЕЛЬ =====================
% Вычисление определителя матрицы
determinant([], 0) :- !.
determinant([[X]], X) :- !.
determinant([[A, B], [C, D]], Det) :-
Det = A * D - B * C, !.
determinant(Matrix, Det) :-
Matrix = [FirstRow|_],
calculate_det(Matrix, FirstRow, 1, 0, Det).

calculate_det(_, [], _, Acc, Acc) :- !.
calculate_det(Matrix, [H|T], Col, Acc, Det) :-
get_minor(Matrix, 1, Col, Minor),
determinant(Minor, MinorDet),
get_sign(Col, Sign),
Cofactor = Sign * H * MinorDet,
NewAcc = Acc + Cofactor,
NextCol = Col + 1,
calculate_det(Matrix, T, NextCol, NewAcc, Det).

% Знак кофактора (-1)^(i+j)
get_sign(Col, 1) :-
Col mod 2 = 1, !.
get_sign(_, -1).

% Минор матрицы без столбца и строки с данным элементом
get_minor(Matrix, RowToRemove, ColToRemove, Minor) :-
remove_row(Matrix, RowToRemove, TempMatrix),
remove_column_from_matrix(TempMatrix, ColToRemove, Minor).

% Удаление строки из матрицы
remove_row([_|Rest], 1, Rest) :- !.
remove_row([Row|Rest], N, [Row|Result]) :-
N > 1,
NextN = N - 1,
remove_row(Rest, NextN, Result).

% Удаление столбца из матрицы
remove_column_from_matrix([], _, []).
remove_column_from_matrix([Row|Rest], Col, [NewRow|Result]) :-
remove_element(Row, Col, NewRow),
remove_column_from_matrix(Rest, Col, Result).

% Удаление элемента
remove_element([_|Rest], 1, Rest) :- !.
remove_element([H|Rest], Pos, [H|Result]) :-
Pos > 1,
NextPos = Pos - 1,
remove_element(Rest, NextPos, Result).

% ================ ЧИСЛО ОБУСЛОВЛЕННОСТИ =====================
% Размер матрицы
matrix_size([], 0).
matrix_size([_|Rest], Size) :-
matrix_size(Rest, RestSize),
Size = RestSize + 1.

% Безопасное извлечение корня
safe_sqrt(X, Result) :-
X >= 0, !,
Result = sqrt(X).
safe_sqrt(X, Result) :-
Result = sqrt(-X).

% Расчет нормы Фробениуса
frobenius_norm(Matrix, Norm) :-
frobenius_norm_acc(Matrix, 0, Norm).

frobenius_norm_acc([], Acc, Norm) :-
safe_sqrt(Acc, Norm).
frobenius_norm_acc([Row|Rest], Acc, Norm) :-
row_squared_sum(Row, RowSum),
NewAcc = Acc + RowSum,
frobenius_norm_acc(Rest, NewAcc, Norm).

row_squared_sum([], 0).
row_squared_sum([H|T], Sum) :-
row_squared_sum(T, RestSum),
Sum = H * H + RestSum.

% Проверка на матрицу 1x1
check_1x1(0, 1e308) :- !.
check_1x1(_, 1).

% Вычисление сингулярных значений для матрицы 2x2
calculate_2x2_singular_values(Matrix, SigmaMax, SigmaMin) :-
Matrix = [[A, B], [C, D]],
T1 = A*A + B*B + C*C + D*D,
Discriminant = (A*A + B*B + C*C + D*D)*(A*A + B*B + C*C + D*D) - 4*(A*D - B*C)*(A*D - B*C),
safe_sqrt(Discriminant, T2),
SigmaMax = sqrt((T1 + T2) / 2),
SigmaMin = sqrt((T1 - T2) / 2).

% Вычисление числа обусловленности по сингулярным значениям
calculate_condition_from_singular_values(SigmaMax, 0, 1e308) :- !.
calculate_condition_from_singular_values(SigmaMax, SigmaMin, Cond) :-
Cond = SigmaMax / SigmaMin.

% Расчет числа обусловленности с помощью SVD
condition_number_svd(Matrix, Cond) :-
matrix_size(Matrix, N),
N = 1, !,
Matrix = [[A]],
check_1x1(A, Cond).

condition_number_svd(Matrix, Cond) :-
matrix_size(Matrix, N),
N = 2, !,
calculate_2x2_singular_values(Matrix, SigmaMax, SigmaMin),
calculate_condition_from_singular_values(SigmaMax, SigmaMin, Cond).

condition_number_svd(Matrix, Cond) :-
frobenius_norm(Matrix, Norm),
Norm = 0, !,
Cond = 1e308.

condition_number_svd(Matrix, Cond) :-
frobenius_norm(Matrix, Norm),
Cond = Norm * 10.

% Упрощенный метод вычисления числа обусловленности
check_norm(0, 1e308) :- !.
check_norm(Norm, Cond) :-
Cond = Norm * 10.

% Простая оценка числа обусловленности с использованием нормы Фробениуса
condition_number(Matrix, Cond) :-
frobenius_norm(Matrix, Norm),
check_norm(Norm, Cond).

% ================ РАНГ МАТРИЦЫ =====================
% Главный предикат для вычисления ранга
matrix_rank(Matrix, Rank) :-
find_matrix_rank(Matrix, Rank).

% Нахождение ранга перебором всех возможных размеров подматриц
find_matrix_rank(Matrix, Rank) :-
matrix_size(Matrix, Rows),
get_first_column(Matrix, Cols),
get_min_dimension(Rows, Cols, MaxPossibleRank),
find_rank(Matrix, MaxPossibleRank, 0, Rank).

% Рекурсивный поиск ранга
% Базовый случай - если не нашли миноры большего размера, возвращаем текущий максимум
find_rank(_, 0, CurrentRank, CurrentRank) :- !.
find_rank(Matrix, CurrentSize, CurrentMax, FinalRank) :-
has_any_nonzero_minor(Matrix, CurrentSize), !,
FinalRank = CurrentSize.

find_rank(Matrix, CurrentSize, CurrentMax, FinalRank) :-
CurrentSize > 0,
NextSize = CurrentSize - 1,
find_rank(Matrix, NextSize, CurrentMax, FinalRank).

% Проверка существования любого ненулевого минора размера K
has_any_nonzero_minor(Matrix, K) :-
get_all_submatrices(Matrix, K, Submatrices),
contains_nonzero_det(Submatrices).

contains_nonzero_det([]) :- fail.
contains_nonzero_det([Matrix|_]) :-
determinant(Matrix, Det),
abs(Det) > 1e-10,
!.
contains_nonzero_det([_|Rest]) :-
contains_nonzero_det(Rest).

% Получение всех возможных подматриц размера K×K
get_all_submatrices(Matrix, K, AllSubmatrices) :-
findall(Submatrix, get_kxk_submatrix(Matrix, K, Submatrix), AllSubmatrices).

% Получение одной подматрицы K×K
get_kxk_submatrix(Matrix, K, Submatrix) :-
matrix_size(Matrix, TotalRows),
get_first_column(Matrix, TotalCols),
combination(TotalRows, K, RowIndices),
combination(TotalCols, K, ColIndices),
extract_submatrix(Matrix, RowIndices, ColIndices, Submatrix).

% Генерация комбинаций (выбор K элементов из N)
combination(N, K, Comb) :-
numlist(1, N, List),
comb(K, List, Comb).

comb(0, _, []) :- !.
comb(K, [H|T], [H|Comb]) :-
K > 0,
K1 = K - 1,
comb(K1, T, Comb).
comb(K, [_|T], Comb) :-
K > 0,
comb(K, T, Comb).

% Извлечение подматрицы по заданным индексам строк и столбцов
extract_submatrix(Matrix, RowIndices, ColIndices, Submatrix) :-
extract_rows_by_indices(Matrix, RowIndices, SelectedRows),
extract_columns_from_rows(SelectedRows, ColIndices, Submatrix).

% Извлечение строк по индексам
extract_rows_by_indices(_, [], []) :- !.
extract_rows_by_indices(Matrix, [RowIndex|Rest], [Row|Result]) :-
get_nth_row(Matrix, RowIndex, Row),
extract_rows_by_indices(Matrix, Rest, Result).

% Получение N-й строки матрицы
get_nth_row([Row|_], 1, Row) :- !.
get_nth_row([_|Rest], N, Row) :-
N > 1,
N1 = N - 1,
get_nth_row(Rest, N1, Row).

% Извлечение столбцов из набора строк
extract_columns_from_rows([], _, []) :- !.
extract_columns_from_rows([Row|Rest], ColIndices, [SelectedCols|Result]) :-
extract_elements_by_indices(Row, ColIndices, SelectedCols),
extract_columns_from_rows(Rest, ColIndices, Result).

% Извлечение элементов списка по индексам
extract_elements_by_indices(_, [], []) :- !.
extract_elements_by_indices(List, [Index|Rest], [Element|Result]) :-
get_nth_element(List, Index, Element),
extract_elements_by_indices(List, Rest, Result).

% Получение N-го элемента списка (индексация с 1)
get_nth_element([H|_], 1, H) :- !.
get_nth_element([_|T], N, Element) :-
N > 1,
N1 = N - 1,
get_nth_element(T, N1, Element).

% Генерация списка чисел от M до N
numlist(N, List) :-
numlist(1, N, List).
numlist(M, N, []) :-
M > N, !.
numlist(M, N, [M|Rest]) :-
M <= N,
M1 = M + 1,
numlist(M1, N, Rest).

% Базовые предикаты для работы с матрицами
get_first_column([Row|_], Cols) :-
length_row(Row, Cols).

length_row([], 0).
length_row([_|T], Len) :-
length_row(T, LenT),
Len = LenT + 1.

get_min_dimension(Rows, Cols, Rows) :-
Rows <= Cols, !.
get_min_dimension(Rows, Cols, Cols) :-
Rows > Cols.

% ================ ОСНОВНОЙ ПРОЦЕСС =====================
% Ожидание
wait_for_enter :-
write("\nPress Enter to exit"),
readchar(_).

% Основной процесс
process_file1 :-
existfile("matrix.txt"),
!,
write("File found, opening"), nl,
openread(file_pointer, "matrix.txt"),
readdevice(file_pointer),
read_number(Rows),
read_number(Cols),
write("Dimensions: ", Rows, " x ", Cols), nl,
process_file2(Rows, Cols).

process_file1 :-
write("Error: File matrix.txt not found"), nl.

process_file2(Rows, Cols) :-
Rows = Cols,
!,
write("Matrix is square, loading data"), nl,
load_matrix(Rows, Cols, Matrix),
readdevice(keyboard),
closefile(file_pointer),
print_matrix(Rows, Cols, Matrix),
determinant(Matrix, Det),
write("Determinant = ", Det), nl,
condition_number_svd(Matrix, Cond),
writef("Condition number = %-4.2f", Cond), nl,
matrix_rank(Matrix, Rank),
write("Matrix rank = ", Rank), nl.

process_file2(Rows, Cols) :-
write("Matrix is not square, loading data"), nl,
load_matrix(Rows, Cols, Matrix),
readdevice(keyboard),
closefile(file_pointer),
print_matrix(Rows, Cols, Matrix),
matrix_rank(Matrix, Rank),
write("Matrix rank = ", Rank), nl.

GOAL
clearwindow,
write("Reading matrix from file matrix.txt"), nl, nl,
process_file1,
wait_for_enter.

Входной файл для единичной.
1
1
5