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

invGaussIter n a b aResult bResult row | row >= n = (aResult, bResult)

|otherwise =

let maxRow = findMaxAbsInColumn n a row aSwapped = exchangeRowsInMatrix n a row maxRow

bSwapped = exchangeRowsInMatrix n b row maxRow (aDiv, bDiv) = invGaussIterDiv n aSwapped bSwapped row

in invGaussIter n aDiv bDiv aDiv bDiv (row + 1)

invGauss :: Int -> Matrix -> Matrix

invGauss n a = snd $ invGaussIter n a (eyeMatrix n n) a (eyeMatrix n n) 0

inv :: Int -> Matrix -> Matrix inv n a = invGauss n a

-- Собственные векторы

data EigenResult = EigenResult { eigenvectors :: [Vector], eigenvals :: [Double], iterations :: Int } minElementOfVector :: Vector -> Double

minElementOfVector = minimum maxElementOfVector :: Vector -> Double maxElementOfVector = maximum isEigenvectorStable :: Vector -> Vector -> Bool isEigenvectorStable x ax =

let divs = divVectors ax x

minDiv = minElementOfVector divs maxDiv = maxElementOfVector divs

in maxDiv - minDiv < 1e-6

isEigenvectorsStable :: [Vector] -> [Vector] -> Bool isEigenvectorsStable [] [] = True

isEigenvectorsStable (x:xs) (ax:axs) = isEigenvectorStable x ax && isEigenvectorsStable xs axs isEigenvectorsStable _ _ = False

calcEigenvalue :: Vector -> Vector -> Double calcEigenvalue x ax =

let divs = divVectors ax x

in safeDiv (minimum divs + maximum divs) 2.0

11

calcEigenvalues :: [Vector] -> [Vector] -> [Double] calcEigenvalues xs axs = [calcEigenvalue x ax | (x, ax) <- zip xs axs] --Удаление компоненты

removeComponent :: Vector -> Vector -> Vector removeComponent v1 v2 =

let prod = dotProduct v1 v2 norm2 = dotProduct v2 v2 projCoeff = safeDiv prod norm2

proj = multRowNum projCoeff v2

in addRows v1 (multRowNum (-1.0) proj) --Удаление компоненты из векторов

removeComponentFromVectors :: [Vector] -> Vector -> [Vector] removeComponentFromVectors [] _ = [] removeComponentFromVectors (v:vs) normV =

let v1 = removeComponent v normV normalized = vectorNormalization v1

in normalized : removeComponentFromVectors vs normV --Функция вызова алгоритма Грамма-Шмидта grammSchmidt :: [Vector] -> [Vector]

grammSchmidt [] = [] grammSchmidt (v:vs) =

let normV = vectorNormalization v

in normV : grammSchmidt (removeComponentFromVectors vs normV) processCandidates :: Int -> Int -> Matrix -> [Vector] -> [Vector] processCandidates n k m x =

let tx = transposeMatrix x tmx = multMatrix m tx

in transposeMatrix tmx

generateBetterInitialVectors :: Int -> [Vector] generateBetterInitialVectors n =

let base = replicate n 1.0

vectors = map (\i -> replicate i 0.0 ++ [1.0] ++ replicate (n-i-1) 0.1) [0..n-1] in map vectorNormalization vectors

-- Итерации

12

findEigenvectorsLimited :: Int -> Int -> Matrix -> [Vector] -> Int -> EigenResult findEigenvectorsLimited n k m currentX iter

| iter > 3000 =

let mx = processCandidates n k m currentX

in EigenResult currentX (calcEigenvalues currentX mx) iter

|otherwise =

let mx = processCandidates n k m currentX in if isEigenvectorsStable currentX mx

then EigenResult currentX (calcEigenvalues currentX mx) iter else findEigenvectorsLimited n k m (grammSchmidt mx) (iter + 1)

findEigenvectors :: Int -> Int -> Matrix -> [Vector] -> EigenResult findEigenvectors n k m x = findEigenvectorsLimited n k m x 0

-- Симметрия матрицы

isMatrixSymmetric :: Int -> Int -> Matrix -> Bool isMatrixSymmetric _ _ m = m == transposeMatrix m

-- Проверка размеров матриц

checkDimensions :: Int -> Int -> Int -> Int -> Int -> Either String () checkDimensions aRows aCols bRows bCols k

| aRows /= aCols = Left "Matrix A is not square" | bRows /= bCols = Left "Matrix B is not square"

| aRows /= bRows = Left "Matrix A and B have different dimensions"

prettyPrintMatrix :: Matrix -> String

prettyPrintMatrix m = unlines $ map (unwords . map show) m

-- Чтение матрицы

readMatrixFromFile :: FilePath -> IO Matrix readMatrixFromFile filePath = do

contents <- readFile filePath

return $ map (map read . words) (lines contents)

-- Main main :: IO () main = do

13

matrixA <- readMatrixFromFile "A.txt" matrixB <- readMatrixFromFile "B.txt" let n = length matrixA

k = n

dimCheck = checkDimensions (length matrixA) (length $ head matrixA) (length matrixB) (length $ head matrixB) k

case dimCheck of

Left err -> putStrLn $ "Error: " ++ err Right _ -> do

putStrLn "=== Matrix Eigenvalue Problem Solver ==="

putStrLn "Matrix A:"

putStrLn $ prettyPrintMatrix matrixA putStrLn "Matrix B:"

putStrLn $ prettyPrintMatrix matrixB

let invB = inv n matrixB

m = multMatrix invB matrixA symmetric = isMatrixSymmetric n n m

putStrLn "Matrix M = inv(B) * A:" putStrLn $ prettyPrintMatrix m

putStrLn $ "Is M symmetric: " ++ show symmetric if not symmetric

then putStrLn "Warning: Matrix M is not symmetric!" else do

let isAllOnes = all (all (\x -> isRealsEqual x 1.0)) m initialVectors = if isAllOnes

then generateBetterInitialVectors n else transposeMatrix (eyeMatrix n k)

result = findEigenvectors n k m initialVectors let evecs = eigenvectors result

evals = eigenvals result iters = iterations result

if iters > 3000

then putStrLn "WARNING: Maximum iterations reached!" else putStrLn "Successfully converged!"

putStrLn $ "Found " ++ show k ++ " eigenvalues: " ++ show evals

14

Тестирование

Для проверки работоспособности программы были выполнены тестовые запуски. 1. Для матриц:

Рисунок 5. Результат теста для первого набора матриц

2. Для матриц:

Рисунок 6. Результат теста для второго набора матриц

3. Для матриц:

15

Рисунок 3. Результат теста для третьего набора матриц

Рисунок 4. Результат теста для четвертого набора матриц

Рисунок 5. Результат теста для пятого набора матриц

16

Рисунок 6. Результат теста для шестого набора матриц

Заключение

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

17