pessimus - Haskell Метод Гаусса
Среда, 07.12.2016, 00:46
Приветствую Вас Гость | RSS
Форма входа
Поиск
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Haskell Метод Гаусса

....Функциональный язык Haskell невероятно интересен для программиста, никогда раньше  не работавшего в этом стиле. Каждая задача представляет собой настоящую головоломку. В руководствах по программированию обычно рассматривают только самые элементарные примеры. Здесь приводится вариант программного кода для решения системы линейных алгебраических уравнений методом последовательных исключений Гаусса. Никакие библиотечные модули не использовались, кроме простейших встроенных функций. (Ссылка для скачивания внизу)
....Обычно утверждают, что код на Haskell отличается особой лаконичностью и даже элегантностью, легко читаем и достаточно прост. На данном примере каждый может составить своё мнение на этот счёт. Во всяком случае, несомненно, что код этот весьма оригинален.
....Программы на данном языке очень затратны в отношении оперативной памяти, однако, для современных компьютеров этот фактор не слишком важен. Эффективность в отношении времени каждый может легко  проверить на данном примере, выполнив сравнительные расчёты (надо ввести main и откомпилировать). Исходные данные, как это видно из примера, формируются в виде массива (на Haskell - список), элементами которого являются строки исходной матрицы, включая правые части. Результат программа возвращает в виде массива искомых значений.
....Я намеренно не стал оформлять код в виде самостоятельного модуля, чтобы можно было сразу выполнить её в интерпретаторе Haskell, для чего достаточно загрузить программу и выполнить директивой "res". Сделать самостоятельный модуль и написать обращение к нему в языке Haskell чрезвычайно просто. Привожу код на Haskell:

aish1 = [[2,1,3,7,8], [3.0,2,1,1,9], [2.0,4,3,2,11], [1,4,5,3,11]]
aish = agl aish1 (length aish1)
a = aish ++ [last aish]
f _ 0 = []
f a n = [b] ++ f d (n-1) where
        b = map(/(head(head a))) (head a)         --Деление первого уравнения
        fi _ 0 = []                               --на превый (ведущий) коэффициент
        fi r m = fi r (m-1) ++ [(v r 0 d)] where  --и умножение первого уравнения 
                 d = map (*head(r !! m)) b        --на первый к-т n-го уравнения
                 v _ _ []= []
                 v r k (x:xs) = [(((r !! m) !! k) - x)] ++ v r (k+1) xs
        fi1 [] _ = []                             --Приведение матрицы к треугольному виду
        fi1 a n = [tail(head(fi a n))] ++ fi1 (tail a) n   --
        c = fi1 a n
        d = agl c n    
b = f a (length aish)
n = (length aish) -1
r  _ (-1) = []   
r b n = [xk] ++ r c (n-1) where
        xk = last(b !! n)   --Вычитание из правых частей последнего коэф-та,
        rab _ (-1) = []     --умноженного на известный уже результат
        rab b k = [last(b !! k)- xk*(last (init (b !! k)))] ++ rab b (k-1)
        e _ (-1) = []       --Уничтожение последнего члена всех уравнений
        e b l = [init (init (b !! l)) ++ [d !! l]] ++ e b (l-1) where
                d = reverse (rab b l)
        c = reverse (e b 2)
res = reverse (r b n)
       
agl a n = agl1 aglpr i bi where   --Перестановка уравнений для выбора "главного коэф-та"
        agl1 (y:z) i bi = fst a ++ [bi] ++tail(snd a) where
                          a = splitAt i (y:z)  
        aglpr = [a !! i] ++ tail a
        i = (indmax b n) -1 where
            b = per1 a (n-1) where
                el a c = (a !! (fst c)) !! (snd c)?
                per1 _ (-1) = []
                per1 a n = [abs(el a (n,0))] ++ per1 a (n-1)
            indmax [] _ = 0
            indmax b n = if (head b) == mx then n else indmax (tail b) (n-1) where
                         mx = maximum b
        bi = head a
--Для решения примера в интерпретаторе - вызов res


В качестве примера для сравнения - этот же алгоритм на языке Ruby. Программа написана в процедурном стиле . Язык Ruby , пожалуй, самый объектно-ориентированный, позволяет без проблем использовать и традиционный стиль. 

 a=[[3.0,1,2,4,11],[8.0,3,5,1,20],[-12.0,2,1,4,-3],[1.0,3,7,2,16]]
#a=[[3.0,1.0,1.0,6.0],[2.0,3.0,1.0,9.0],[1.0,3.0,4.0,11.0]]
def glav a
    b = a.collect {|x| x[0]}   #Нахождение максимального по модулю
    b=b.collect {|x| x.abs}   #элемента в первом столбце и
    n = b.index b.max          #перестановка уравнений
    a[0],a[n]=a[n],a[0]
    a
end

def iscl a
    n = a.length; x = a[0][0]
    b = a[0].collect {|c| c/x}
    a[0]=b;                 #Деление первого уравнения на первый элемент
    for j in (1...n)       #и исключение первого неизвестного из остальных уравнений                 
        b=[]
        for i in (0..n)
            b[i]=a[j][i]-a[0][i]*a[j][0]
        end
    a[j]=b
    end
    a
end
def treug a   
    c=[]; n=a.length             #Приведение матрицы к треугольному виду
    for j in (1..n)
        glav a
        iscl a
        c = c+[a[0]]
        a.shift
        a.collect {|x| x.shift}
    end
    c
end
def iscl1 a
    n=a.length; c = []       #Вычисление неизвестных (обратный ход)
    for j in (1...n)
        c = c+[a[n-j][1]]
        for i in (0...n-j)
            a[i][n-i-j]=a[i][n-i-j+1]-c[j-1]*a[i][n-i-j]
            a[i].pop
        end
        a.pop
    end
    c = c+[a[0][1]]
end
           
res=iscl1(treug a).reverse
p res


.................Ссылка для скачивания файла sistalg.hs


                                                                                                    http://pessim50.ucoz.ru/sistalg.hs