REPOS_ERICCA/magicsld/Outils_Math.vb

Imports System.Math

Module Outils_Math


#Region "calcul matriciel & vectoriel"

    Public Function Addition(ByRef A(,) As Double, ByRef B(,) As Double) As Double(,)
        'additionne deux matrices et le résultat est renvoyé dans la fonction

        ' vérification que l'on peut additionner, si toutes les matrices sont de 1 à nb, on devrait pas faire ça car ça bouffe du temps...
        Dim ua1 As Double, ub1 As Double
        Dim ua2 As Double, ub2 As Double

        ua1 = UBound(A, 1)
        ua2 = UBound(A, 2)
        ub1 = UBound(B, 1)
        ub2 = UBound(B, 2)

        If (Not ua1 - ub1 = 0) Or (Not ua2 - ub2 = 0) Then
            MsgBox("deux matrices ne peuvent pas s'additionner")
            Return Nothing
        End If

        Dim matC(ua1, ua2) As Double

        Dim i, j As Integer
        For i = 0 To ub1
            For j = 0 To ub2
                matC(i, j) = A(i, j) + B(i, j)
            Next j
        Next i

        Addition = matC
    End Function

    Public Function addition(ByRef a() As Double, ByRef b() As Double) As Double()
        ' addition de vecteurs

        If Not UBound(a) = UBound(b) Then
            MsgBox("Deux vecteurs ne peuvent s'additionner...")
            Return Nothing
        End If

        Dim i As Integer
        Dim c(UBound(a)) As Double

        For i = 0 To UBound(a)
            c(i) = a(i) + b(i)
        Next

        Return c
    End Function

    Public Function multiscal(ByRef A(,) As Double, ByRef c As Double) As Double(,)
        ' multiplie la matrice a par le scalaire c
        Dim i As Integer
        Dim j As Integer

        Dim B(UBound(A, 1), UBound(A, 2)) As Double

        For i = 0 To UBound(A, 1)
            For j = 0 To UBound(A, 2)
                B(i, j) = A(i, j) * c
            Next j
        Next i

        multiscal = B
    End Function

    Public Function multiscal(ByRef A() As Double, ByRef c As Double) As Double()
        'multiplie un vecteur par une certaine valeur
        Dim i As Integer
        Dim b(UBound(A)) As Double
        For i = 0 To UBound(A)
            b(i) = A(i) * c
        Next

        multiscal = b
    End Function

    Public Function reduit(ByRef A(,) As Double, Optional ByVal colonne As Integer = -1, Optional ByRef ligne As Integer = -1) As Double(,)
        ' fonction qui retire une colonne et /ou une ligne d'une matrice
        Dim temp(UBound(A, 1) - 1, UBound(A, 2) - 1) As Double
        Dim i As Integer, j As Integer, k As Integer, l As Integer


        For l = 0 To UBound(A)
            If Not (l = ligne) Then
                j = 0
                For k = 0 To UBound(A)
                    If Not (k = colonne) Then
                        temp(i, j) = A(l, k)
                        j += 1
                    End If
                Next k
                i += 1
            End If
        Next l


        reduit = temp
    End Function

    Public Function reduit(ByRef A() As Double, Optional ByVal colonne As Integer = -1) As Double()
        ' fonction qui retire un élément d'un vecteur
        Dim temp(UBound(A)) As Double
        Dim i As Double, l As Double

        While l < UBound(A)
            If Not l = colonne Then
                temp(i) = A(l)
                l = l + 1
                i = i + 1
            Else
                i = i + 1
            End If
        End While

        Return temp
    End Function

    Public Function multiplication(ByVal A(,) As Double, ByVal B(,) As Double) As Double(,)
        ' le vecteur C est redimensionné correctement
        ' [A]*[B] = [C]
        ' si B est un vecteur alors on va à la partie en bas

        Dim i, j, k, n, m As Integer
        Dim c(,) As Double

        m = UBound(B, 2)
        n = UBound(A, 1)

        If UBound(B, 1) <> UBound(A, 2) Then MsgBox(" Incompatibilité de matrices pour la multiplication") : Return Nothing

        ReDim c(n, m)

        For j = 0 To m
            For i = 0 To n
                For k = 0 To UBound(A, 2)
                    c(i, j) = c(i, j) + A(i, k) * B(k, j)
                Next k
            Next i
        Next j

        multiplication = c
    End Function

    Public Function multiplication(ByRef A(,) As Double, ByRef b() As Double) As Double()
        ' le vecteur C est redimensionné correctement
        ' [A]*{B} = {C}
        ' B est un vecteur ligne

        Dim i, j, n, m As Integer
        Dim c() As Double

        m = UBound(b)
        n = UBound(A, 1)

        If UBound(A, 2) <> m Then MsgBox("Impossible de multiplier la matrice avec le vecteur, dimensions incompatibles!") : Return Nothing

        ' on multiplie une matrice et un vecteur

        ReDim c(m)

        For i = 0 To UBound(b)
            For j = 0 To UBound(b)
                c(i) = c(i) + A(i, j) * b(j)
            Next j
        Next i
        Return c
    End Function

    Public Function multiplication(ByRef a() As Double, ByRef B(,) As Double) As Double()
        ' le vecteur C est redimensionné correctement
        ' {A}*[B] = {C}
        ' A est un vecteur  colonne

        Dim i, j, n, m As Integer
        Dim c() As Double

        m = UBound(a)
        n = UBound(B, 2)

        If m <> UBound(B, 1) Then MsgBox("Impossible de multiplier le veteur par la matrice.") : Return Nothing

        ReDim c(m)

        For i = 0 To UBound(B)
            For j = 0 To UBound(B)
                c(i) = c(i) + a(j) * B(j, i)
            Next j
        Next i
        Return c
    End Function

    Public Function soustraction(ByRef A(,) As Double, ByRef B(,) As Double) As Double(,)
        'C = A - B
        Dim C(,) As Double
        Dim m As Integer, n As Integer
        m = UBound(A, 1)
        n = UBound(A, 2)

        If (m <> UBound(B, 1)) Or (n <> UBound(B, 2)) Then MsgBox("Impossible de soustraire les matrices, dimensions non compatibles") : Return Nothing

        ReDim C(m, n)

        Dim i, j As Integer
        For i = 0 To m
            For j = 0 To n
                C(i, j) = A(i, j) - B(i, j)
            Next j
        Next i
        Return C
    End Function

    Public Function transpose(ByRef A(,) As Double) As Double(,)

        Dim c(,) As Double
        Dim i, j As Integer
        ReDim c(UBound(A, 2), UBound(A, 1))

        For i = 0 To UBound(A, 1)
            For j = 1 To UBound(A, 2)
                c(j, i) = A(i, j)
            Next j
        Next i

        Return c
    End Function

    Public Function gauss(ByRef A(,) As Double, ByRef C() As Double) As Double()
        ' [A]{X} = {C}
        ' les matrices doivent être déjà dimensionnées
        Dim n As Integer
        Dim i, j, k As Integer
        Dim rapport As Double

        n = UBound(A, 1)
        Dim rep() As Double
        ReDim rep(n)


        For i = 0 To n              ' de gauche à droite
            pivoter(i, A, C)

            'Call Form1.affiche(mat(), C())
            'MsgBox i

            For j = i + 1 To n      ' les lignes
                rapport = A(j, i) / A(i, i)
                For k = 1 To n      ' les colonnes
                    A(j, k) = A(j, k) - A(i, k) * rapport
                Next k
                C(j) = C(j) - C(i) * rapport
            Next j

        Next i


        Dim stuff As Double
        For i = n To 0 Step -1
            stuff = 0
            For j = i + 1 To n
                stuff = stuff + A(i, j) * rep(j)
            Next j
            rep(i) = (C(i) - stuff) / A(i, i)
        Next i
        C = rep
        gauss = rep
    End Function

    Private Sub pivoter(ByVal i As Integer, ByRef mat(,) As Double, ByRef C() As Double)
        ' sub qui pivote la ligne i de la matrice a ( et du vecteur C).  Si et seulement si le pivotage est nécessaire.
        Dim n As Integer
        n = UBound(mat, 1)
        Dim a_pivoter As Integer

        Dim z As Integer
        Dim temp As Double
        Dim tempC As Double

        For z = i To n
            temp = mat(i, i)

            If mat(z, i) > Math.Abs(temp) Then ' on a trouvé une ligneà pivoter
                temp = mat(z, i)
                a_pivoter = z
            End If
        Next z
        'MsgBox a_pivoter

        If a_pivoter <> 0 Then ' on pivote
            ' on pivote la ligne i et la ligne a_pivoter
            tempC = C(i)
            C(i) = C(a_pivoter)
            C(a_pivoter) = tempC

            For z = 0 To n
                temp = mat(i, z)
                mat(i, z) = mat(a_pivoter, z)
                mat(a_pivoter, z) = temp
            Next z

        End If
        ' fin pivot
    End Sub

    Private Function pivoter(ByVal i As Integer, ByRef mat(,) As Double) As Integer
        ' sub qui pivote la ligne i de la matrice a ( et du vecteur C).  Si et seulement si le pivotage est nécessaire.
        Dim n As Integer
        n = UBound(mat, 1)
        Dim a_pivoter As Integer
        pivoter = 1

        Dim z As Integer
        Dim temp As Double

        For z = i To n
            temp = mat(i, i)

            If mat(z, i) > Math.Abs(temp) Then ' on a trouvé une ligne à pivoter
                temp = mat(z, i)
                a_pivoter = z
                pivoter = -1
            End If
        Next z

        If a_pivoter <> 0 Then ' on pivote

            For z = 0 To n
                temp = mat(i, z)
                mat(i, z) = mat(a_pivoter, z)
                mat(a_pivoter, z) = temp
            Next z

        End If
        ' fin pivot
    End Function

    Public Function norme(ByRef u() As Double) As Double
        ' calcul la norme (longueur) d'un vecteur à xDimensions
        Dim i As Integer
        Dim temp As Double

        For i = 0 To UBound(u)
            temp = temp + u(i) ^ 2
        Next i
        Return Math.Sqrt(temp)
    End Function

    Public Function Prod_scalaire(ByRef u() As Double, ByRef v() As Double) As Double
        ' fait le produit scalaire entre deux vecteurs
        ' en notation indicielle: w = uivi
        Dim i As Integer

        For i = 0 To UBound(u)
            Prod_scalaire = Prod_scalaire + u(i) * v(i)
        Next i

    End Function

    Public Function prod_vect3D(ByRef u() As Double, ByRef v() As Double) As Double()
        ' fait le produit vectoriel entre les vecteur 3D u et v
        ' [ i  j  k  ]
        ' | u1 u2 u3 |
        ' [ v1 v2 v3 ]
        '
        ' w = (u2*v3 - u3*v2) i - (u1*v3 - u3*v1) j + (u1*v2-u2*v1) k
        Dim w(2) As Double
        w(0) = u(2) * v(3) - u(3) * v(2)
        w(1) = -(u(1) * v(3) - u(3) * v(1))
        w(2) = u(1) * v(2) - u(2) * v(1)

        prod_vect3D = w

    End Function

    Public Function unitaire(ByRef u() As Double) As Double()
        ' prend le vecteur u et son vecteur unitaire v
        Dim longueur As Double
        Dim i As Integer
        Dim v() As Double
        ReDim v(UBound(u))

        Dim temp As Double
        For i = 0 To UBound(u)
            temp = temp + u(i) ^ 2
        Next i
        longueur = Math.Sqrt(temp)
        For i = 0 To UBound(u)
            v(i) = u(i) / longueur
        Next i

        unitaire = v
    End Function

    Public Function cosdir(ByRef u() As Double, ByRef v() As Double) As Double
        ' retourne le cosinus entre deux vecteurs, u et v
        cosdir = Prod_scalaire(u, v) / norme(u) / norme(v)
    End Function

    Public Function projection(ByVal u() As Double, ByVal e() As Double) As Double
        ' projette le vecteur u sur e et retourne
        ' le résultat est la longueur sur le vecteur e
        projection = norme(u) * cosdir(u, e)
    End Function


    Public Function det(ByRef A(,) As Double) As Double
        ' calcule le détrminant de la matrice A
        Dim i As Long
        Dim temp As Double
        ' contrôle d'erreur:
        If UBound(A, 1) <> UBound(A, 2) Then
            MsgBox("Impossible de calculer le déterminant, la matrice n'est pas carrée")
        End If

        Dim n As Integer
        Dim j As Integer, k As Integer
        Dim rapport As Double

        n = UBound(A, 1)
        Dim rep() As Double
        ReDim rep(n)

        temp = 1
        For i = 0 To n              ' de gauche à droite
            temp *= pivoter(i, A)

            For j = i + 1 To n      ' les lignes
                rapport = A(j, i) / A(i, i)
                For k = 1 To n      ' les colonnes
                    A(j, k) = A(j, k) - A(i, k) * rapport
                Next k
            Next j
        Next i

        ' à partir d'ici on a une matrice triangulaire suppérieure. (mais je me casse pas la tête à mettre des 0...)

        For i = 0 To UBound(A)
            temp *= A(i, i)
        Next

        Return temp
    End Function


    Public Function det2(ByRef A(,) As Double) As Double
        ' calcul du déterminant à l'aide du cofacteur

        Dim i As Long
        Dim temp As Double
        ' contrôle d'erreur:
        If UBound(A, 1) <> UBound(A, 2) Then
            MsgBox("Impossible de calculer le déterminant, la matrice n'est pas carrée")
        End If

        If UBound(A) = 0 Then det2 = A(0, 0) : Exit Function
        Dim B(,) As Double
        ReDim B(UBound(A) - 1, UBound(A) - 1)


        For i = 0 To UBound(A)
            B = (reduit(A, i, 0))
            temp += (-1) ^ i * det2(reduit(A, i, 0)) * A(0, i)
        Next i

        det2 = temp

    End Function


    'Function qui compare 2 vecteurs.  retourne 0 si non alignés.  1 si dans le même sens, 2 si de sens opposé.
    Public Function CompareSens(ByRef u() As Double, ByRef v() As Double, Optional ByVal Epsilon As Double = 0.000000001) As Integer
        If ((u(0) - v(0)) < Epsilon) And ((u(1) - v(1)) < Epsilon) And ((u(2) - v(2)) < Epsilon) Then Return 1
        If ((u(0) + v(0)) < Epsilon) And ((u(1) + v(1)) < Epsilon) And ((u(2) + v(2)) < Epsilon) Then Return 2
        Return 0
    End Function

#End Region

#Region "calcul intégral"


    Function rectangles(ByRef dx As Double, Optional ByVal a As Double = 0, Optional ByVal b As Double = 1) As Double
        ' function qui calcule l'intégrale de f par la méthode des rectangles
        Dim ecart As Double
        Dim i As Integer
        Dim nb As Long
        Dim x As Double
        Dim aire As Double

        ecart = b - a

        nb = CLng(ecart / dx)
        dx = ecart / nb

        If nb < 100 Then MsgBox("Attention, moins de 100 rectangles seront utilisés pour calculer l'intégrale")

        x = a
        For i = 1 To nb
            aire += f(x + dx / 2) * dx
            x += dx
        Next

        rectangles = aire

    End Function


    Function trapezes(ByRef dx As Double, Optional ByVal a As Double = 0, Optional ByVal b As Double = 1) As Double
        ' function qui calcule l'intégrale de f par la méthode des trapezes
        Dim ecart As Double
        Dim i As Integer
        Dim nb As Long
        Dim x As Double
        Dim aire As Double

        ecart = b - a
        nb = CLng(ecart / dx)
        dx = ecart / nb

        If nb < 100 Then MsgBox("Attention, moins de 100 trapezes seront utilisés pour calculer l'intégrale")

        x = a
        For i = 1 To nb
            aire += (f(x) + f(x + dx)) / 2 * dx
            x += dx
        Next

        trapezes = aire
    End Function


    Function IntegrationGauss(ByRef n As Integer, Optional ByRef noFunction As Integer = 1) As Double
        Dim i As Integer
        Dim temp As Double
        Dim t() As Double
        Dim w() As Double
        ReDim w(0)
        ReDim t(0)

        Select Case n
            Case 1 ' un seul point d'intégration
                ReDim t(0)
                ReDim w(0)

                t(0) = 0
                w(0) = 2

            Case 2 ' deux points d'intégration
                ' somme wi f(ri)
                ReDim t(1)
                ReDim w(1)

                t(0) = -0.57735027
                t(1) = 0.57735027

                w(0) = 1
                w(1) = 1

            Case 3 ' trois points
                ReDim t(2)
                ReDim w(2)

                t(0) = -0.77459667
                t(1) = 0
                t(2) = 0.77459667

                w(0) = 5 / 9
                w(1) = 8 / 9
                w(2) = 5 / 9

            Case 4

                ReDim t(3)
                ReDim w(3)

                t(0) = -0.86113631
                t(1) = -0.33998104
                t(2) = 0.33998104
                t(3) = 0.86113631

                w(0) = 0.34785485
                w(1) = 0.65214515
                w(2) = 0.65214515
                w(3) = 0.34785485


            Case 5
                ReDim t(4)
                ReDim w(4)

                t(0) = -0.90617975
                t(1) = -0.53846931
                t(2) = 0
                t(3) = 0.53846931
                t(4) = 0.90617975

                w(0) = 0.23692689
                w(1) = 0.47862867
                w(2) = 0.56888889
                w(3) = 0.47862867
                w(4) = 0.23692689

            Case Else
                MsgBox("Problème dans l'intégration de Gauss, nb de points d'intégration non reconnu!?!")
        End Select


        For i = 0 To n - 1
            temp = temp + w(i) * Choose(noFunction, f1(t(i)), f2(t(i)), f3(t(i)), f4(t(i)), f5(t(i)))
        Next

        IntegrationGauss = temp
    End Function


    Function simpson(ByRef dx As Double, Optional ByVal a As Double = 0, Optional ByVal b As Double = 1) As Double


    End Function

#End Region


    Public Function f(ByVal x As Double) As Double
        f = x ^ 2
    End Function
    Public Function f1(ByVal r As Double) As Double
        f1 = -0.04 * (-3 + r) * r ^ 2
    End Function
    Public Function f2(ByVal r As Double) As Double
        f2 = -0.04 * (-3 + r) * r ^ 2
    End Function
    Public Function f3(ByVal r As Double) As Double
        f3 = -0.04 * (-3 + r) * r ^ 2
    End Function
    Public Function f4(ByVal r As Double) As Double
        f4 = -0.04 * (-3 + r) * r ^ 2
    End Function
    Public Function f5(ByVal r As Double) As Double
        f5 = -0.04 * (-3 + r) * r ^ 2
    End Function


    ' Secant
    Public Function Sec(ByVal X As Double) As Double
        Sec = 1 / Math.Cos(X)
    End Function

    ' Cosecant
    Public Function CoSec(ByVal X As Double) As Double
        CoSec = 1 / Math.Sin(X)
    End Function

    ' Cotangent
    Public Function CoTan(ByVal X As Double) As Double
        CoTan = 1 / Math.Tan(X)
    End Function

    ' Inverse Sine
    Public Function ArcSin(ByVal X As Double) As Double
        ArcSin = Math.Atan(X / Math.Sqrt(-X * X + 1))
    End Function

    ' Inverse Cosine
    Public Function ArcCos(ByVal X As Double) As Double
        ArcCos = Math.Atan(-X / Math.Sqrt(-X * X + 1)) + 2 * Math.Atan(1)
    End Function

    ' Inverse Secant
    Public Function ArcSec(ByVal X As Double) As Double
        ArcSec = Math.Atan(X / Math.Sqrt(X * X - 1)) + Math.Sign(X - 1) * (2 * Math.Atan(1))
    End Function

    ' Inverse Cosecant
    Public Function ArcCoSec(ByVal X As Double) As Double
        ArcCoSec = Math.Atan(X / Math.Sqrt(X * X - 1)) + (Math.Sign(X) - 1) * (2 * Math.Atan(1))
    End Function

    ' Inverse Cotangent
    Public Function ArcCoTan(ByVal X As Double) As Double
        ArcCoTan = Math.Atan(X) + 2 * Math.Atan(1)
    End Function


    ' Hyperbolic Secant
    Public Function HSec(ByVal X As Double) As Double
        HSec = 2 / (Math.Exp(X) + Math.Exp(-X))
    End Function

    ' Hyperbolic Cosecant
    Public Function HCoSec(ByVal X As Double) As Double
        HCoSec = 2 / (Math.Exp(X) - Math.Exp(-X))
    End Function

    ' Hyperbolic Cotangent
    Public Function HCotan(ByVal X As Double) As Double
        HCotan = (Math.Exp(X) + Math.Exp(-X)) / (Math.Exp(X) - Math.Exp(-X))
    End Function

    ' Inverse Hyperbolic Sine
    Public Function HArcSin(ByVal X As Double) As Double
        HArcSin = Math.Log(X + Math.Sqrt(X * X + 1))
    End Function

    ' Inverse Hyperbolic Cosine
    Public Function HArcCos(ByVal X As Double) As Double
        HArcCos = Math.Log(X + Math.Sqrt(X * X - 1))
    End Function

    ' Inverse Hyperbolic Tangent
    Function HArcTan(ByVal X As Double) As Double
        HArcTan = Math.Log((1 + X) / (1 - X)) / 2
    End Function

    ' Inverse Hyperbolic Secant
    Public Function HArcSec(ByVal X As Double) As Double
        HArcSec = Math.Log((Math.Sqrt(-X * X + 1) + 1) / X)
    End Function

    ' Inverse Hyperbolic Cosecant
    Public Function HArcCoSec(ByVal X As Double) As Double
        HArcCoSec = Math.Log((Math.Sign(X) * Math.Sqrt(X * X + 1) + 1) / X)
    End Function

    ' Inverse Hyperbolic Cotangent
    Public Function HArcCoTan(ByVal X As Double) As Double
        HArcCoTan = Math.Log((X + 1) / (X - 1)) / 2
    End Function

    ' Logarithm to base N
    Public Function LogN(ByVal X As Double, ByVal n As Double) As Double
        LogN = Math.Log(X) / Math.Log(n)
    End Function

    ' function qui effectue la rotation d'un point Pt par la matrice Mat
    Public Function Rotation2D(ByRef Mat(,) As Double, ByVal Pt() As Double) As Double()
        Dim temp(1) As Double

        temp(0) = Mat(0, 0) * Pt(0) + Mat(0, 1) * Pt(1)
        temp(1) = Mat(0, 1) * Pt(0) + Mat(1, 1) * Pt(1)

        Return temp

    End Function

    ' function qui effectue la rotation d'un point Pt par le vecteur UNITAIRE u
    Public Function Rotation2D(ByRef u() As Double, ByVal Pt() As Double) As Double()
        Dim temp(1) As Double
        'Dim longueur As Double = Math.Sqrt(u(0) * u(0) + u(1) * u(1))
        'u(0) /= longueur
        'u(1) /= longueur

        Dim test(2) As Double
        test(0) = 1
        'Debug.Print(Outils_Math.Angle2Vecteurs(test, u))
        'Debug.Print(Outils_Math.Angle2Vecteurs(test, Pt))

        'temp(0) = u(0) * Pt(0) - u(1) * Pt(1)
        'temp(1) = u(1) * Pt(0) + u(0) * Pt(1)

        'Debug.Print(Outils_Math.Angle2Vecteurs(test, temp))

        Dim u2(2) As Double
        u2(0) = u(0)
        u2(1) = u(1)
        Dim angleInit As Double = Math.Atan2(u(1), u(0))
        Dim anglePt As Double = Math.Atan2(Pt(1), Pt(0))
        Dim longueur As Double = Math.Sqrt(Pt(0) * Pt(0) + Pt(1) * Pt(1))

        Dim anglefinal As Double = anglePt + angleInit
        temp(0) = Math.Cos(anglefinal) * longueur
        temp(1) = Math.Sin(anglefinal) * longueur

        Return temp

    End Function


    'Private Function Angle2D(ByRef u() As Double) As Double
    '    If Math.Sign(u(0)) = 1 AndAlso Math.Sign(u(1)) = 1 Then
    '        Return (Math.Atan(u(1) / u(0)))
    '    ElseIf Math.Sign(u(0)) = -1 AndAlso Math.Sign(u(1)) = 1 Then ' 2nd quadrant
    '        Return (Math.Atan(u(1) / u(0)))
    '    ElseIf Math.Sign(u(0)) = -1 AndAlso Math.Sign(u(1)) = 1 Then ' 3ieme quadrant
    '        Return (Math.Atan(u(1) / u(0))) + 2 * Math.PI
    '    Else
    '        Return (Math.Atan(u(1) / u(0))) + 2 * Math.PI
    '        math.
    '    End If
    'End Function


    Public Sub Rotation2D(ByRef u() As Double, ByRef Ptx As Double, ByRef Pty As Double)
        Dim temp(1) As Double
        Dim longueur As Double = Math.Sqrt(u(0) * u(0) + u(1) * u(1))
        u(0) /= longueur
        u(1) /= longueur

        temp(0) = u(0) * Ptx - u(1) * Pty
        temp(1) = u(1) * Ptx + u(0) * Pty

        Ptx = temp(0)
        Pty = temp(1)

    End Sub


    ''' <summary>
    ''' Retourne l'angle entre 2 vecteurs
    ''' </summary>
    ''' <param name="u">Le premier vecteur</param>
    ''' <param name="v">Le second vecteur</param>
    ''' <returns>Un angle en radian</returns>
    ''' <remarks>Retourne Pi si les 2 vecteurs sont d'orientation identique mais de direction opposés</remarks>
    Public Function Angle2Vecteurs(ByRef u() As Double, ByRef v() As Double) As Double
        Dim temp As Double
        temp = Outils_Math.Prod_scalaire(u, v) / norme(u) / norme(v)
        If Math.Abs(temp - 1) < 0.000000000001 Or Math.Abs(temp + 1) < 0.000000000001 Then
            Return Pi
        Else
            Return Math.Acos(temp)
        End If
    End Function


    ''' <summary>
    ''' Compare 2 vecteur de dimension 3
    ''' </summary>
    ''' <param name="u">Premier Vecteur</param>
    ''' <param name="v">Second vecteur</param>
    ''' <returns>0 si sans rapport, 1 si identiques, 2 si sens inverse, 3 si même sens mais norme différente, 4 si norme et sens différent</returns>
    ''' <remarks>Non optimisé pour les vecteurs unitaires</remarks>
    Public Function ComparerVecteurs3D(ByRef u() As Double, ByRef v() As Double) As Byte

        If u.GetUpperBound(0) <> 2 AndAlso v.GetUpperBound(0) <> 2 Then Return 0
        If Math.Abs(u(0) - v(0)) < 0.0005 AndAlso Math.Abs(u(1) - v(1)) < 0.0005 AndAlso Math.Abs(u(1) - v(1)) < 0.0005 Then Return 1
        If Math.Abs(u(0) + v(0)) < 0.0005 AndAlso Math.Abs(u(1) + v(1)) < 0.0005 AndAlso Math.Abs(u(1) + v(1)) < 0.0005 Then Return 2

        Dim u2() As Double = unitaire(u)
        Dim v2() As Double = unitaire(v)

        If Math.Abs(u2(0) - v2(0)) < 0.0005 AndAlso Math.Abs(u2(1) - v2(1)) < 0.0005 AndAlso Math.Abs(u2(1) - v2(1)) < 0.0005 Then Return 3
        If Math.Abs(u2(0) + v2(0)) < 0.0005 AndAlso Math.Abs(u2(1) + v2(1)) < 0.0005 AndAlso Math.Abs(u2(1) + v2(1)) < 0.0005 Then Return 4

        Return 0

    End Function

    ''' <summary>
    ''' Fonction qui inverse le sens d'un vecteur
    ''' </summary>
    ''' <param name="u">Le vecteur</param>
    ''' <returns>Un vecteur de direction inverse</returns>
    ''' <remarks></remarks>
    Public Function InverserVecteur(ByRef u() As Double) As Double()
        Dim v() As Double
        ReDim v(u.GetUpperBound(0))

        For i As Integer = 0 To u.GetUpperBound(0)
            v(i) = -u(i)
        Next
        Return v
    End Function


End Module
Revision:	205
Committed:	Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size:	26520 byte(s)
Log Message:	Commit de MAGiC_SLD pendant que j'y pense. Les modifications ne devraient pas concerner personne d'autre que moi. -- Sylvain