Task: Determinant and permanent








VB: Module Module1

    Function Minor(a As Double(,), x As Integer, y As Integer) As Double(,)
        Dim length = a.GetLength(0) - 1
        Dim result(length - 1, length - 1) As Double
        For i = 1 To length
            For j = 1 To length
                If i < x AndAlso j < y Then
                    result(i - 1, j - 1) = a(i - 1, j - 1)
                ElseIf i >= x AndAlso j < y Then
                    result(i - 1, j - 1) = a(i, j - 1)
                ElseIf i < x AndAlso j >= y Then
                    result(i - 1, j - 1) = a(i - 1, j)
                Else
                    result(i - 1, j - 1) = a(i, j)
                End If
            Next
        Next
        Return result
    End Function

    Function Det(a As Double(,)) As Double
        If a.GetLength(0) = 1 Then
            Return a(0, 0)
        Else
            Dim sign = 1
            Dim sum = 0.0
            For i = 1 To a.GetLength(0)
                sum += sign * a(0, i - 1) * Det(Minor(a, 0, i))
                sign *= -1
            Next
            Return sum
        End If
    End Function

    Function Perm(a As Double(,)) As Double
        If a.GetLength(0) = 1 Then
            Return a(0, 0)
        Else
            Dim sum = 0.0
            For i = 1 To a.GetLength(0)
                sum += a(0, i - 1) * Perm(Minor(a, 0, i))
            Next
            Return sum
        End If
    End Function

    Sub WriteLine(a As Double(,))
        For i = 1 To a.GetLength(0)
            Console.Write("[")
            For j = 1 To a.GetLength(1)
                If j > 1 Then
                    Console.Write(", ")
                End If
                Console.Write(a(i - 1, j - 1))
            Next
            Console.WriteLine("]")
        Next
    End Sub

    Sub Test(a As Double(,))
        If a.GetLength(0) <> a.GetLength(1) Then
            Throw New ArgumentException("The dimensions must be equal")
        End If

        WriteLine(a)
        Console.WriteLine("Permanant  : {0}", Perm(a))
        Console.WriteLine("Determinant: {0}", Det(a))
        Console.WriteLine()
    End Sub

    Sub Main()
        Test({{1, 2}, {3, 4}})
        Test({{1, 2, 3, 4}, {4, 5, 6, 7}, {7, 8, 9, 10}, {10, 11, 12, 13}})
        Test({{0, 1, 2, 3, 4}, {5, 6, 7, 8, 9}, {10, 11, 12, 13, 14}, {15, 16, 17, 18, 19}, {20, 21, 22, 23, 24}})
    End Sub

End Module



Fortran: 



































program f
  implicit none
  real, dimension(3,3) :: j, m
  data j/ 2,-1, 1,-1,-2, 1,-1,-1,-1/
  data m/2, 9, 4, 7, 5, 3, 6, 1, 8/
  write(6,*) 'j example, determinant: ',det(j,3,-1)
  write(6,*) 'j example, permanent:   ',det(j,3,1)
  write(6,*) 'maxima, determinant:    ',det(m,3,-1)
  write(6,*) 'maxima, permanent:      ',det(m,3,1)

contains

  recursive function det(a,n,permanent) result(accumulation)
    
    
    real, dimension(n,n), intent(in) :: a
    integer, intent(in) :: n, permanent
    real, dimension(n-1, n-1) :: b
    real :: accumulation
    integer :: i, sgn
    if (n .eq. 1) then
      accumulation = a(1,1)
    else
      accumulation = 0
      sgn = 1
      do i=1, n
        b(:, :(i-1)) = a(2:, :i-1)
        b(:, i:) = a(2:, i+1:)
        accumulation = accumulation + sgn * a(1, i) * det(b, n-1, permanent)
        sgn = sgn * permanent
      enddo
    endif
  end function det

end program f