Task: Gaussian elimination







Python: 


import copy
from fractions import Fraction

def gauss(a, b):
    a = copy.deepcopy(a)
    b = copy.deepcopy(b)
    n = len(a)
    p = len(b[0])
    det = 1
    for i in range(n - 1):
        k = i
        for j in range(i + 1, n):
            if abs(a[j][i]) > abs(a[k][i]):
                k = j
        if k != i:
            a[i], a[k] = a[k], a[i]
            b[i], b[k] = b[k], b[i]
            det = -det
            
        for j in range(i + 1, n):
            t = a[j][i]/a[i][i]
            for k in range(i + 1, n):
                a[j][k] -= t*a[i][k]
            for k in range(p):
                b[j][k] -= t*b[i][k]
                
    for i in range(n - 1, -1, -1):
        for j in range(i + 1, n):
            t = a[i][j]
            for k in range(p):
                b[i][k] -= t*b[j][k]
        t = 1/a[i][i]
        det *= a[i][i]
        for j in range(p):
            b[i][j] *= t
    return det, b

def zeromat(p, q):
    return [[0]*q for i in range(p)]

def matmul(a, b):
    n, p = len(a), len(a[0])
    p1, q = len(b), len(b[0])
    if p != p1:
        raise ValueError("Incompatible dimensions")
    c = zeromat(n, q)
    for i in range(n):
        for j in range(q):
                c[i][j] = sum(a[i][k]*b[k][j] for k in range(p))
    return c


def mapmat(f, a):
    return [list(map(f, v)) for v in a]

def ratmat(a):
    return mapmat(Fraction, a)



a = [[2, 9, 4], [7, 5, 3], [6, 1, 8]]
b = [[1, 0, 0], [0, 1, 0], [0, 0, 1]]
det, c = gauss(a, b)

det
-360.0

c
[[-0.10277777777777776, 0.18888888888888888, -0.019444444444444438],
[0.10555555555555554, 0.02222222222222223, -0.061111111111111116],
[0.0638888888888889, -0.14444444444444446, 0.14722222222222223]]


matmul(a, c)
[[1.0, 0.0, 0.0], [5.551115123125783e-17, 1.0, 0.0],
[1.1102230246251565e-16, -2.220446049250313e-16, 1.0]]



det, c = gauss(ratmat(a), ratmat(b))

det
Fraction(-360, 1)

c
[[Fraction(-37, 360), Fraction(17, 90), Fraction(-7, 360)],
[Fraction(19, 180), Fraction(1, 45), Fraction(-11, 180)],
[Fraction(23, 360), Fraction(-13, 90), Fraction(53, 360)]]

matmul(a, c)
[[Fraction(1, 1), Fraction(0, 1), Fraction(0, 1)],
[Fraction(0, 1), Fraction(1, 1), Fraction(0, 1)],
[Fraction(0, 1), Fraction(0, 1), Fraction(1, 1)]]




Fortran:         program ge

          real, allocatable :: a(:,:),b(:)
          a = reshape(                             &
          [1.0, 1.00, 1.00,  1.00,   1.00,   1.00, &
           0.0, 0.63, 1.26,  1.88,   2.51,   3.14, &
           0.0, 0.39, 1.58,  3.55,   6.32,   9.87, &
           0.0, 0.25, 1.98,  6.70,  15.88,  31.01, &
           0.0, 0.16, 2.49, 12.62,  39.90,  97.41, &
           0.0, 0.10, 3.13, 23.80, 100.28, 306.02], [6,6] )
          b = [-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]
          print'(f15.7)',solve_wbs(ge_wpp(a,b))

        contains
  
          function solve_wbs(u) result(x) 
            real                 :: u(:,:)
            integer              :: i,n
            real   , allocatable :: x(:)
            n = size(u,1)
            allocate(x(n))
            forall (i=n:1:-1) x(i) = ( u(i,n+1) - sum(u(i,i+1:n)*x(i+1:n)) ) / u(i,i)
          end function

          function  ge_wpp(a,b) result(u) 
            real                 :: a(:,:),b(:),upi
            integer              :: i,j,n,p
            real   , allocatable :: u(:,:)
            n = size(a,1)
            u = reshape( [a,b], [n,n+1] )
            do j=1,n
              p = maxloc(abs(u(j:n,j)),1) + j-1 
              if (p /= j) u([p,j],j) = u([j,p],j)
              u(j+1:,j) = u(j+1:,j)/u(j,j)
              do i=j+1,n+1
                upi = u(p,i)
                if (p /= j) u([p,j],i) = u([j,p],i)
                u(j+1:n,i) = u(j+1:n,i) - upi*u(j+1:n,j)
              end do
            end do
          end function

        end program