Лабораторные работы. Ерофеев / Разработка ИИ. Отчет №6

Постановка задачи

Разработать программу на Haskell для определения собственных значений обобщённой проблемы Ax = λBx методом итераций в подпространстве.

Алгоритм программы

Для достижения данной цели необходимо выполнить следующие задачи:

1.Загрузка данных: считать матрицы A и B из файлов.

2.Проверка корректности: убедиться, что матрицы квадратные и одинакового размера

(N > 0), а B — обратима.

3.Приведение к стандартной форме: преобразовать задачу к виду Mx = λx, где M = B^{- 1} * A.

4.Решение методом итераций в подпространстве:

·Выбрать начальное приближение для подпространства собственных векторов (например, единичную матрицу).

·Итерационно уточнять подпространство, умножая его на матрицу M и проводя ортогонализацию (процесс Грамма-Шмидта).

5.Вычисление собственных значений: после сходимости вычислить собственные значения.

Алгоритм итераций

1. Выбираются несколько нормированных и взаимно ортогональных векторов. Эти вектора удобно представить себе в виде матрицы. Например, единичной матрицы S:

2. Выполняется итерация, которая в данном случае представляет собой умножение исследуемой матрицы М на матрицу S.

=

В этот момент проверяется сходимость. Если отношения элементов первого столбца C и соответствующих элементов первого столбца S одинаковы (в реальных вычислениях очень близки), то первый столбец есть собственный вектор, соответствующий наибольшему собственному значению матрицы. Само же это отношение и будет искомым собственным значением:

=

2

3.Столбцы полученной матрицы C ортонормируют (процесс Грамма-Шмидта). Полученную матриц обозначаем S и ее столбцы рассматриваем как очередное приближение собственных векторов.

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

Процесс Грамма-Шмидта

Из набора векторов V выбирается один и нормируется, например, V2:

Полученный нормированный вектор V2 служит основой для удаления компоненты из других векторов, например, из V1. V1 — это исходный вектор (Vj), из которого удаляется проекция на V2. В результате получается V3 — вектор V1 без проекции на V2.

Удаление проекции осуществляется по формуле:

3 = – ,

В контексте алгоритма Грамма-Шмидта:

1.Сначала выбирается первый вектор и нормируется.

2.Затем из всех остальных векторов удаляется компонента вдоль этого нормированного вектора.

3.После этого выбирается следующий вектор, нормируется, и процесс повторяется.

Перечень функций

1.epsilon — константа для сравнения чисел с нулём.

2.safeDiv — деление двух чисел.

3.dotProduct — скалярное произведение двух векторов.

4.vectorNorm — евклидова норма вектора.

5.vectorNormalization — нормализация вектора до единичной длины.

6.addRows — поэлементное сложение двух векторов.

7.multRowNum — умножение вектора на скаляр.

8.absElem — модуль числа.

9.isRealZero — проверка, является ли число нулем.

10.isRealsEqual — проверка равенства двух вещественных чисел с учётом точности.

11.divReal — безопасное поэлементное деление векторов.

3

42.checkDimensions — проверка корректности размерностей матриц.

43.prettyPrintMatrix — вывод матрицы.

44.readMatrixFromFile — чтение матрицы из текстового файла.

Схема

Рисунок 1. Блок схема основной программы

5

Рисунок 2. Вычисление обратной матрицы

Рисунок 3. Нахождение собственных векторов

6

Рисунок 4. Алгоритм Грамма-Шмидта

Программа

module MatrixEigenComplete where type Matrix = [[Double]]

type Vector = [Double] epsilon :: Double epsilon = 1e-7

safeDiv :: Double -> Double -> Double safeDiv _ 0 = 0.0

safeDiv x y = x / y

-- Умножение векторов

dotProduct :: Vector -> Vector -> Double dotProduct xs ys = sum $ zipWith (*) xs ys

7

-- Нормализация

vectorNorm :: Vector -> Double vectorNorm v =

let normSq = dotProduct v v

in if normSq < epsilon then 0.0 else sqrt normSq

vectorNormalization :: Vector -> Vector vectorNormalization v

| norm < epsilon = v

| otherwise = map (/ norm) v where norm = vectorNorm v

addRows :: Vector -> Vector -> Vector addRows = zipWith (+)

multRowNum :: Double -> Vector -> Vector multRowNum k = map (* k)

absElem :: Double -> Double absElem = abs

isRealZero :: Double -> Bool isRealZero x = absElem x < epsilon

isRealsEqual :: Double -> Double -> Bool isRealsEqual x y = isRealZero (x - y)

divReal :: Double -> Double -> Double divReal _ 0 = 0.0

divReal x y = x / y

divVectors :: Vector -> Vector -> Vector divVectors = zipWith divReal

-- Извлечение элемента

extractRowElement :: Int -> Vector -> Double extractRowElement i row = row !! i

8

extractMatrixElement :: Int -> Int -> Matrix -> Double

extractMatrixElement row col matrix = extractRowElement col (matrix !! row)

extractRow :: Int -> Matrix -> Vector extractRow i matrix = matrix !! i

modRowInMatrix :: Int -> Matrix -> Int -> Vector -> Matrix modRowInMatrix _ matrix 0 newRow = newRow : tail matrix modRowInMatrix n matrix rowIndex newRow =

take rowIndex matrix ++ [newRow] ++ drop (rowIndex + 1) matrix

exchangeRowsInMatrix :: Int -> Matrix -> Int -> Int -> Matrix exchangeRowsInMatrix _ matrix r1 r2

| r1 == r2 = matrix | otherwise =

let row1 = extractRow r1 matrix row2 = extractRow r2 matrix

in modRowInMatrix (length matrix) (modRowInMatrix (length matrix) matrix r1 row2) r2 row1

--Транспонирование матрицы transposeMatrix :: Matrix -> Matrix transposeMatrix [] = [] transposeMatrix ([]:_) = []

transposeMatrix m = map head m : transposeMatrix (map tail m)

--Умножение матриц

multMatrixElem :: Int -> Int -> Matrix -> Matrix -> Double

multMatrixElem i j a b = dotProduct (extractRow i a) [extractMatrixElement k j b | k <- [0..length a - 1]]

multMatrixRow :: Matrix -> Matrix -> Int -> Vector

multMatrixRow a b rowIndex = [multMatrixElem rowIndex j a b | j <- [0..length (head b) - 1]]

multMatrix :: Matrix -> Matrix -> Matrix

multMatrix a b = [multMatrixRow a b i | i <- [0..length a - 1]]

eyeMatrix :: Int -> Int -> Matrix

9

eyeMatrix n cols = [[if i == j then 1.0 else 0.0 | j <- [0..cols-1]] | i <- [0..n-1]]

-- Алгоритм Гаусса-Жордана findMaxAbsInColumn :: Int -> Matrix -> Int -> Int findMaxAbsInColumn n matrix col =

snd $ maximum [(absElem (extractMatrixElement row col matrix), row) | row <- [col..n-1]]

eliminateColumn :: Int -> Matrix -> Matrix -> Int -> Int -> (Matrix, Matrix) eliminateColumn n a b col row

| row >= n = (a, b)

| row == col = eliminateColumn n a b col (row + 1)

|otherwise =

let element = extractMatrixElement row col a

colRowA = multRowNum (-element) (extractRow col a) colRowB = multRowNum (-element) (extractRow col b) rowA = extractRow row a

rowB = extractRow row b

newRowA = addRows rowA colRowA newRowB = addRows rowB colRowB

aNew = modRowInMatrix n a row newRowA bNew = modRowInMatrix n b row newRowB in eliminateColumn n aNew bNew col (row + 1)

invGaussIterDiv :: Int -> Matrix -> Matrix -> Int -> (Matrix, Matrix) invGaussIterDiv n a b rowIndex =

let pivot = extractMatrixElement rowIndex rowIndex a in if isRealZero pivot

then error "Matrix is singular - no inverse exists" else

let scale = safeDiv 1.0 pivot

pivotRowA = multRowNum scale (extractRow rowIndex a) pivotRowB = multRowNum scale (extractRow rowIndex b) aScaled = modRowInMatrix n a rowIndex pivotRowA bScaled = modRowInMatrix n b rowIndex pivotRowB

in eliminateColumn n aScaled bScaled rowIndex 0

invGaussIter :: Int -> Matrix -> Matrix -> Matrix -> Matrix -> Int -> (Matrix, Matrix)

10