Блок-схемы
Проверка функционала программы
Для проверки работоспособности программы были выполнены тестовые запросы. Результаты выполнения запросов приведены ниже в виде скриншотов, подтверждающих корректность работы программы.
Рисунок 1. Результаты для 7 точек.
Рисунок 2. График аппроксимации.
Рисунок 3. Результаты для 11 точек.
Рисунок 4. График аппроксимации.
Рисунок 5. Результаты для 10 точек.
Рисунок 6. График аппроксимации.
Рисунок 7. Результаты для 20 точек.
Рисунок 8. График аппроксимации.
Рисунок 9. Результаты для 50 точек с сильным шумом.
Рисунок 10. График аппроксимации.
Код программы
{-# LANGUAGE FlexibleContexts #-}
import System.IO
import Text.Read (readMaybe)
import Numeric.LinearAlgebra
import Text.Printf (printf)
import Data.List (foldl')
import Control.Monad (when)
-- ==================== ТИПЫ ====================
type Point = (Double, Double)
-- ==================== ЧТЕНИЕ ФАЙЛА ====================
readPoints :: FilePath -> IO [Point]
readPoints filepath = do
contents <- readFile filepath
return $ parseLines (lines contents)
where
parseLines :: [String] -> [Point]
parseLines = mapMaybe parseLine
parseLine :: String -> Maybe Point
parseLine line = case words line of
[xStr, yStr] -> (,) <$> readMaybe xStr <*> readMaybe yStr
_ -> Nothing
mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe f = foldr (\x acc -> case f x of
Just val -> val : acc
Nothing -> acc) []
-- ==================== ОБРАБОТКА ДУБЛИКАТОВ И НЕОДНОЗНАЧНОСТИ ====================
-- | Удаление дубликатов по X
removeDuplicates :: [Point] -> IO [Point]
removeDuplicates points = do
let (result, warnings) = foldl' processPoint ([], []) points
-- Выводим предупреждения о неоднозначности
mapM_ (\(x, existingY, newY) ->
printf "Предупреждение: неоднозначность при x=%.6f (y=%.6f, но уже есть y=%.6f) - точка игнорируется\n"
x newY existingY) warnings
return (reverse result)
where
processPoint :: ([Point], [(Double, Double, Double)])
-> Point
-> ([Point], [(Double, Double, Double)])
processPoint (acc, warnings) (x, y) =
case findSimilarX x acc of
Nothing ->
-- X уникален, добавляем точку
((x, y) : acc, warnings)
Just (_, existingY) ->
-- X уже существует
if abs (existingY - y) < 1e-12
then
-- Y одинаковый - полный дубликат
(acc, warnings)
else
-- Разные Y - неоднозначность
(acc, (x, existingY, y) : warnings)
-- Поиск точки с таким же X
findSimilarX :: Double -> [Point] -> Maybe Point
findSimilarX x [] = Nothing
findSimilarX x ((x', y'):rest)
| abs (x' - x) < 1e-12 = Just (x', y')
| otherwise = findSimilarX x rest
-- ==================== СОРТИРОВКА ПЕРЕМЕШИВАНИЕМ ====================
shakerSort :: [Point] -> [Point]
shakerSort points = shakerSort' points [] False
where
shakerSort' [] acc swapped = if swapped then shakerSort' (reverse acc) [] False else reverse acc
shakerSort' [x] acc swapped = shakerSort' [] (x:acc) swapped
shakerSort' (p1@(x1, _):p2@(x2, _):xs) acc swapped
| x1 > x2 = shakerSort' (p1:xs) (p2:acc) True
| otherwise = shakerSort' (p2:xs) (p1:acc) swapped
-- ==================== АППРОКСИМАЦИЯ ====================
-- | Проверка возможности аппроксимации
canApproximate :: Int -> Int -> Bool
canApproximate numPoints degree = degree + 1 <= numPoints
-- | Вычисление максимально допустимой степени полинома
maxPossibleDegree :: Int -> Int
maxPossibleDegree numPoints = numPoints - 1
leastSquaresSVD :: [Point] -> Int -> Vector Double
leastSquaresSVD pts m =
let xs = map fst pts
ys = map snd pts
n = length xs
a = (n >< (m + 1)) [x ^ i | x <- xs, i <- [0..m]]
b = vector ys
xMat = linearSolveSVD a (asColumn b)
coeffs = flatten xMat
in coeffs
-- ==================== ВЫЧИСЛЕНИЕ ЗНАЧЕНИЯ ПОЛИНОМА =================
evalPolynomial :: Vector Double -> Double -> Double
evalPolynomial coeffs x =
sum [coeffs ! i * (x ^ i) | i <- [0 .. size coeffs - 1]]
-- ==================== ГЕНЕРАЦИЯ ТОЧЕК ДЛЯ ГРАФИКА ====================
generateGrid :: Double -> Double -> Int -> [Double]
generateGrid xMin xMax n =
let step = (xMax - xMin) / fromIntegral (n - 1)
in [xMin + fromIntegral i * step | i <- [0..n-1]]
createGraphPoints :: Vector Double -> Double -> Double -> Int -> [(Double, Double)]
createGraphPoints coeffs xMin xMax nPoints =
let xs = generateGrid xMin xMax nPoints
in [(x, evalPolynomial coeffs x) | x <- xs]
-- ==================== ВЫВОД РЕЗУЛЬТАТОВ ====================
formatPoints :: [(Double, Double)] -> String
formatPoints = unlines . map (\(x, y) -> printf "%.6f %.6f" x y)
-- ==================== ГЛАВНАЯ ФУНКЦИЯ ====================
main :: IO ()
main = do
putStrLn "=== Аппроксимация методом наименьших квадратов (SVD) ==="
-- 1. Чтение данных из файла
putStrLn "\nВведите имя файла с данными:"
fileName <- getLine
points <- readPoints fileName
when (null points) $ do
putStrLn "Ошибка: файл пуст или содержит некорректные данные"
return ()
putStrLn $ "Прочитано точек: " ++ show (length points)
-- 2. Удаление дубликатов с контролем неоднозначности
putStrLn "\nОбработка дубликатов..."
uniquePoints <- removeDuplicates points
putStrLn $ "После удаления дубликатов и неоднозначных точек: " ++ show (length uniquePoints) ++ " точек"
when (length uniquePoints < 2) $ do
putStrLn "Ошибка: недостаточно точек после удаления дубликатов"
return ()
-- 3. Сортировка перемешиванием
let sortedPoints = shakerSort uniquePoints
putStrLn "Точки отсортированы методом перемешивания"
-- 4. Вывод отсортированных точек
putStrLn "\nОтсортированные точки:"
mapM_ (\(x, y) -> printf " %8.3f %8.3f\n" x y) sortedPoints
-- 5. Ввод степени полинома с проверкой
let numPoints = length sortedPoints
maxDegree = maxPossibleDegree numPoints
putStrLn $ "\nВведите степень полинома (0 <= m <= " ++ show maxDegree ++ "):"
putStrLn $ "Максимальная возможная степень для " ++ show numPoints ++ " точек: " ++ show maxDegree
mStr <- getLine
let mMaybe = readMaybe mStr :: Maybe Int
case mMaybe of
Nothing -> do
putStrLn "Ошибка: введите целое число"
return ()
Just m -> do
-- Проверка корректности степени полинома
if m < 0
then do
putStrLn "Ошибка: степень полинома должна быть >= 0"
return ()
else if m > maxDegree
then do
putStrLn $ "Ошибка: степень полинома слишком высока"
putStrLn $ "Максимальная допустимая степень для " ++
show numPoints ++ " точек: " ++ show maxDegree
putStrLn "Полином степени n можно однозначно построить по n+1 точке"
return ()
else if not (canApproximate numPoints m)
then do
putStrLn "Ошибка: невозможно выполнить аппроксимацию"
return ()
else do
-- 6. Вычисление коэффициентов
putStrLn $ "\nАппроксимация полиномом степени " ++ show m
when (m > numPoints `div` 2) $
putStrLn "Предупреждение: высокая степень полинома может привести к некорректным данным"
let coeffs = leastSquaresSVD sortedPoints m
putStrLn "\nКоэффициенты полинома:"
forM_ [0..m] $ \i ->
printf " a%d = %12.6f\n" i (coeffs ! i)
-- 7. Проверка аппроксимации на исходных точках
putStrLn "\nПроверка на исходных точках:"
putStrLn " x y(исходн) y(аппрокс) Разница"
let totalError = sum $ map (\(x, yOrig) ->
let yApprox = evalPolynomial coeffs x
diff = yOrig - yApprox
in diff * diff) sortedPoints
-- Вычисление среднеквадратичной ошибки
let mse = totalError / fromIntegral numPoints
let rmse = sqrt mse
mapM_ (\(x, yOrig) ->
let yApprox = evalPolynomial coeffs x
diff = yOrig - yApprox
in printf " %6.3f %8.3f %8.3f %8.3f\n" x yOrig yApprox diff
) sortedPoints
printf "\nСумма квадратов ошибок: %.6f\n" totalError
printf "Среднеквадратичная ошибка: %.6f\n" mse
printf "Корень из MSE: %.6f\n" rmse
-- 8. Генерация точек для графика
putStrLn "\nВведите количество точек для построения графика (>= 2):"
nStr <- getLine
let nMaybe = readMaybe nStr :: Maybe Int
case nMaybe of
Nothing -> do
putStrLn "Ошибка: введите целое число"
return ()
Just n -> do
when (n < 2) $ do
putStrLn "Ошибка: количество точек должно быть >= 2"
return ()
let xs = map fst sortedPoints
xMin = minimum xs
xMax = maximum xs
graphPoints = createGraphPoints coeffs xMin xMax n
-- 9. Сохранение результатов
putStrLn "\nСохранение результатов в файл"
-- Сохраняем коэффициенты
writeFile "coefficients.txt" $
unlines [printf "a%d = %.10e" i (coeffs ! i) | i <- [0..m]] ++
printf "SSE = %.10e\nMSE = %.10e\nRMSE = %.10e" totalError mse rmse
-- Сохраняем точки для графика
writeFile "graph_points.txt" $
formatPoints graphPoints
-- Сохраняем информацию об исходных точках и аппроксимации
writeFile "approximation.txt" $
unlines [printf "%8.3f %8.3f" x y | (x, y) <- sortedPoints] ++
unlines [printf "a%d = %12.6f" i (coeffs ! i) | i <- [0..m]] ++
formatPoints graphPoints
putStrLn "Результаты сохранены в файл"
-- Вспомогательная функция для forM_
forM_ :: Monad m => [a] -> (a -> m b) -> m ()
forM_ = flip mapM_
Выводы
В ходе выполнения лабораторной работы была разработана программа на языке Haskell, реализующая аппроксимацию экспериментальных данных методом наименьших квадратов с использованием сингулярного разложения. Разработанная программа обеспечивает:
загрузку пар координат из текстового файла произвольного размера;
автоматическую обработку входных данных, включая удаление дубликатов и контроль неоднозначности значений аргумента;
сортировку исходных точек по возрастанию координаты методом сортировки перемешиванием;
интерактивный ввод пользователем степени аппроксимирующего полинома с проверкой корректности и допустимости выбора;
вычисление коэффициентов аппроксимирующего полинома методом наименьших квадратов с использованием сингулярного разложения (SVD);
оценку качества аппроксимации на основе суммы квадратов ошибок и среднеквадратичных характеристик (SSE, MSE, RMSE);
генерацию численных данных для последующего построения графика аппроксимирующей функции во внешних программных средствах.
Разработанная программа имеет модульную структуру, что упрощает её сопровождение и позволяет в дальнейшем расширять функциональность, например, за счёт использования других типов аппроксимирующих функций или методов численного анализа. Использование сингулярного разложения обеспечивает устойчивость вычислений и корректную работу алгоритма даже при наличии плохо обусловленных данных.
Для реализации и запуска программы использовался компилятор GHC (Glasgow Haskell Compiler). Разработка велась в текстовом редакторе (блокнот), а запуск осуществлялся через командную строку операционной системы Windows 11, что обеспечило простую и гибкую среду разработки без применения интегрированных сред программирования.