Librairie : Math et Calcul Matriciel
Publié : ven. 09/déc./2005 17:16

Elle comprend quelques fonctions mathématiques simples mais utiles comme exponentielle,
Mais surtout tout une bibliothèque pour la manipulation de matrice de réel.
Une matrice est ici déclaré comme une structure comprenant un pointeur sur une zone mémoire comprenant les données, le nombre de colonnes, le nombre de ligne.
Vous trouverez les fonctions de base:
B=A, B=valxA , C=A x B , B =inverse(A), determinant
Ainsi que quelques outils vectoriels,
Vect2=A*Vect1
rotation
ect..



La plupart des fonctions matricielles Allouent une zone mémoire pour la matrice calculée!! Ne pas oublier de libérer la mémoire ( voir freematrice et freevecteur3D)
certaines fonctions sont doublées, la version se terminant par Ex renvoie le resultat dans un pointeur existant passé par paramètre.
Ci - Joint :

Code : Tout sélectionner
;Exemple d'utilisation de la librairie Calcul Matriciel
IncludeFile "CalculMatriciel.pb"
*MatA.Matrice=InitMatrice(3,3)
*MatB.Matrice=InitMatrice(3,3)
V.Vecteur3D
Val.f
Restore A
For i=1 To 3
For j=1 To 3
Read Val
SetElt(*MatA,i,j,Val)
Next j
Next i
Restore b
For i=1 To 3
For j=1 To 3
Read Val
SetElt(*MatB,i,j,Val)
Next j
Next i
Restore V
Read V\x
Read V\y
Read V\z
Debug "MatA:"
AfficheMatrice(*MatA)
Debug ""
Debug "MatB:"
AfficheMatrice(*MatB)
Debug ""
Debug "V:"
AfficheVecteur3D(@V)
Debug""
*U.Vecteur3D=MatriceVecteur3D(*MatA,@V)
Debug "U=matA x V"
AfficheVecteur3D(*U)
Debug ""
*C.Matrice=ProduitMatrice(*MatA,*MatB)
Debug "C=AxB"
AfficheMatrice(*C)
Debug ""
*InvA.Matrice=InverseMatrice(*MatA)
If *InvA
Debug "Inverse de MatA:"
AfficheMatrice(*InvA)
Debug ""
*D.Matrice=ProduitMatrice(*MatA,*InvA)
Debug "D=MatAxInvA"
AfficheMatrice(*D)
Debug "CQFD"
Debug""
Else
Debug " A Non inversible"
EndIf
FreeMatrice(*MatA)
FreeMatrice(*MatB)
FreeMatrice(*C)
freeMatrice(*D)
FreeVecteur3D(*U)
DataSection
A:
Data.f 1,2,3,0,1,-1,1,0,1
b:
Data.f 1,0,0,0,1,3,4,-2,1
V:
Data.f 1,2,1
EndDataSection

Code : Tout sélectionner
; Bibliothèque de Math
; Bibliothèque de Calcul matriciel
;pour des explications sur le Calcul Matriciel
;http://physinfo.univ-tours.fr/Lic_Matrice/Mat1.htm#M1_B12
;Le matrices sont déclarées comme des plages mémoirs de Réel
;Les éléments sont rangés en mémoire, par colonnes
;Mem=(Colonne1)-...(colonne i)...-...(colonne N) chaque colonnes comportent P Elmts
;le premier indice va de 1 à N, le deuxième va de 1 à P
;Certaines fonction sont doublées, celle qui se termine par ex renvoie le résultat par paramètre dans une variable existante
;Toutes les fonctions qui renvoie un matrice ou un vecteur3D lui alloue une place mémoire,
; pensez à la liberer après utilisation!!!
; Exemple *A.matrice=initmatrice(3,3)
; ...
; Code
; ...
; FreeMatrice(*A)
;-*************************************************************************
;-Bibliothèque de fonctions mathématique utiles
;-*************************************************************************
#MinFloat = 0.00000001
#e=2.71828183
#Pi=3.1415926
#Reel=4 ;****Nombre d'octet pour un réel
;-declaration des procedures internes
Declare.l Modulo(Val.l,Modulo.l)
Declare.l signe(Val1.f)
Declare.f Exp(x.f)
;-transforme un réel en entier
Procedure.l entier(Val.f)
If Val-Round(Val,0)<=0.5
ProcedureReturn Round(Val,0)
Else
ProcedureReturn Round(Val,1)
EndIf
EndProcedure
Procedure.l signe(Val1.f)
Protected sgn.l
If Val1=0
sgn=0
Else
If Val1>0
sgn=1
Else
sgn=-1
EndIf
EndIf
ProcedureReturn sgn
EndProcedure
;-Donne le modulo d'un entier ( pour ramener un angle dans 0-360° Par exemple)
Procedure.l Modulo(Val.l,Modulo.l)
Valeur.l=Val
If Valeur>=0
While Valeur>=Modulo
Valeur=Valeur-Modulo
Wend
Else
While Valeur<=-Modulo
Valeur=Valeur+Modulo
Wend
EndIf
ProcedureReturn Valeur
EndProcedure
;-Donne l'exponentielle d'un nombre
Procedure.f Exp(x.f)
Protected e.f
e=Pow(#e,x)
ProcedureReturn e
EndProcedure
;-*************************************************************************
;-********** Fonctions matricielles *************
;-*************************************************************************
Enumeration
#TOUTE
#CARRE
EndEnumeration
Structure res
f.f
l.l
EndStructure
Structure Matrice
Addresse.l ;*Adresse de stockage de la matrice
N.l ;*Nbre de colonnes
P.l ;*Nbre de lignes
EndStructure
Structure Vecteur3D
x.f
y.f
z.f
EndStructure
Structure Vecteur2D
x.f
y.f
EndStructure
Structure Polaire2D
Rayon.f
ANGLE.f
EndStructure
Structure Polaire3D
Rayon.f
Teta.f
Fi.f
EndStructure
;-Déclaration des procédures
;- test l'existence de la matrice, et éventuellement si elle est carré
Declare.l TestMatrice(*Mat.Matrice,Option.l)
;-Affiche une matrice dans le debugger
Declare AfficheMatrice(*Mat.Matrice)
;-Initialise une matrice, Resultat par valeur
Declare InitMatrice(N.l,P.l)
;-Libère une Matrice
Declare.b FreeMatrice(*Mat.Matrice)
;-Contrôle La Validité des indices i & j par rapport aux dimension de la matrice
Declare ControleIndices(*Mat.Matrice,i,j)
;-Renvoi le ième élement de la jème ligne, comme pointeur sur une valeur
Declare.f Elt(*Mat.Matrice,i.l,j.l)
;-Donne la valeur Val à l'élement Mati,j
Declare.b SetElt(*Mat.Matrice,i.l,j.l,Val.f)
;-transfert de A dans B
Declare.b TransfertMatrice(*A.Matrice,*B.Matrice)
;-Copie a dans b qui est créée renvoyer comme pointeur
Declare.b CopyMatrice(*A.Matrice,*B.Matrice)
;-Extrait La colonne i et la ligne j de la matrice *Mat renvoie une matrice d'ordre inférieur
Declare ExtractMatrice(*Mat.Matrice,i.l,j.l)
;-Renvoie la transposé d'une matrice
Declare TransposeMatrice(*Mat.Matrice)
;-Renvoie le produit de Deux Matrices
Declare ProduitMatrice(*A.Matrice,*B.Matrice)
;-Multiplie l'ensemble de la Matrice par Val
Declare MatriceFois(*A.Matrice,Val.f)
;-Ajoute Val à l'ensemble de la Matrice
Declare MatricePlus(*A.Matrice,Val.f)
;-Calcul le Déterminant d'une matrice
Declare.f Determinant(*Mat.Matrice)
;-Calcul l'inverse d'une matrice
;l'inverse d'une matrice est la transposée de la comatrice, matrice des cofacteurs,divisé par le déterminant
;Inv(A)=adj(A)/det(A) adj(A)=transposé(Matrice des cofacteurs=(-1)E(i+j)*Determinant(A-colonne i-ligne j)
Declare InverseMatrice(*Mat.Matrice)
;-*********************************************************************
;-****** calcul Vectoriel
;-*********************************************************************
;-Libère un vecteur 3D
Declare FreeVecteur3D(*Vect.Vecteur3D)
;-Affiche un vecteur 3D dans le Debugger
Declare AfficheVecteur3D(*Vect.Vecteur3D)
;-Calcul le Produit d'une Matrice 3,3 par un vecteur 3D, renvoie un vecteur 3D
Declare MatriceVecteur3D(*Mat.Matrice,*Vect.Vecteur3D)
;-calcul la couleur complementaire d'un vecteur 3D
Declare Complementaire3D(*Coul.Vecteur3D,*Comp.Vecteur3D)
;-Calcul la Norme D'un Vecteur 3D
Declare.f NormeVecteur3D(*Vect.Vecteur3D)
;-Calcul le vecteur liant deux points
Declare CalculVecteur3D(*Vect.Vecteur3D,*P1.Vecteur3D,*P2.Vecteur3D)
;-Normalise un Vecteur3D par le Carré de sa norme
Declare BiNormalisationVecteur3D(*Vect.Vecteur3D)
;-Normalise un vecteur3D
Declare.f NormalisationVecteur3D(*Vect.Vecteur3D)
;-Multiplie un vecteur3D de manière à ramener sa composante Maximale=Val
Declare MaximizeVecteur3D(*Vect.Vecteur3D,Val.f)
;-Normalise un Vecteur par la Somme de ses composantes
Declare SommeUnVecteur3D(*Vect.Vecteur3D)
;-Conbine Deux Vecteur renvoi un pointeur sur vecteur
Declare CombinaisonVecteur3D(Val1.f,*Vect1.Vecteur3D,Val2.f,*Vect2.Vecteur3D)
;-Conbine Deux Vecteur rsultat par paramètre
Declare CombinaisonVecteur3DEx(Val1.f,*Vect1.Vecteur3D,Val2.f,*Vect2.Vecteur3D,*Somme.Vecteur3D)
;-donne un point sur une droite- 0=Pointdeb 1=PointFin
Declare PointSurDroiteEx(*PointDeb.Vecteur3D,*PointFin.Vecteur3D,Val.f,*Res.Vecteur3D)
;-Egalise deux vecteur3D
Declare EgaliseVecteur3D(*Source.Vecteur3D,*Dest.Vecteur3D)
;-Ajoute un vecteur 3D à une somme
Declare SommeVecteur3D(*Somme.Vecteur3D,Val.f,*Vect.Vecteur3D)
;-Multiplie un vecteur3D par Val
Declare Vecteur3DFois(*Vect.Vecteur3D,Val.f)
;-Calcul le scalaire de deux vecteurs 3D
Declare.f Scalaire3D(*A.Vecteur3D,*B.Vecteur3D)
;-Signe de rotation entre vecteur
Declare.l SigneRotationOZ(*A.Vecteur3D,*B.Vecteur3D)
;-Rotation d'un vecteur 3D autour de l'axe Z, Angle en Degrés
Declare.f Rotation3DZ(*A.Vecteur3D,ANGLE.f)
;-Renvoi le vecteur unitaire faisant un angle donné en ° dans le cercle trigo
Declare VecteurTrigo(ANGLE.f)
;-Calcul le scalaire de deux vecteurs 2D
Declare.f Scalaire2D(*A.Vecteur2D,*B.Vecteur2D)
;-_calcul l'intersection de deux droites dans le plan OXY défini par un point et un vecteur directeur
Declare.l IntersectionDroite(*P1.Vecteur3D,*D1.Vecteur3D,*P2.Vecteur3D,*D2.Vecteur3D,*Res.Vecteur3D)
;-******************************************************
;-Polaire 2D
;-******************************************************
;-Donne les coordonnées réelles d'un point à partir d'un centre, d'un focus, et de coordonnées polaires
Declare PolaireToXY(*Pol.Polaire2D,*Centre.Vecteur3D,Focus.f,*Res.Vecteur3D)
;-donne les coordonnées polaires d'un point
Declare XYtoPolaire(*P1.Vecteur3D,*ResPolaire.Polaire2D)
;-******************************************************
;-Polaire 3D
;-******************************************************
;-ramène l'angle dans 0,360°
Declare.l RecalPolaire(*Pol.Polaire3D)
;-Affiche les coordonnées polaires dans le debugger
Declare AffichePolaire(*Pol.Polaire3D)
;-*************************************************************************
;-********** Fonctions matricielles *************
;-*************************************************************************
;- test l'existence de la matrice, et éventuellement si elle est carré, renvoi sa dimension
Procedure.l TestMatrice(*Mat.Matrice,Option.l)
If *Mat And *Mat\N>=1 And *Mat\P>=1
Select Option
Case #CARRE
If *Mat\N=*Mat\P
ProcedureReturn *Mat\N
Else
ProcedureReturn 0
EndIf
Default
ProcedureReturn *Mat\N
EndSelect
Else
ProcedureReturn 0
EndIf
EndProcedure
;-Affiche une matrice dans le debugger
Procedure AfficheMatrice(*Mat.Matrice)
i.l
j.l
If TestMatrice(*Mat,#TOUTE)
For j=1 To *Mat\P
Ligne$=""
For i=1 To *Mat\N
Ligne$=Ligne$+StrF(Elt(*Mat,i,j))+" "
Next i
Debug Ligne$
Next j
Else
Debug "Pas de Matrice!!!"
EndIf
Debug ""
Debug ""
EndProcedure
;-Initialise une matrice
Procedure InitMatrice(N.l,P.l)
If N>0 And P>0
*Mat.Matrice=AllocateMemory(SizeOf(Matrice))
*Mat\N=N
*Mat\P=P
*Mem=AllocateMemory(N*P*#Reel)
If *Mem
*Mat\Addresse=*Mem
Else
*Mat=#Null
EndIf
ProcedureReturn *Mat
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Libère une Matrice
Procedure.b FreeMatrice(*Mat.Matrice)
If *Mat
FreeMemory(*Mat\Addresse)
*Mat\N=0
*Mat\P=0
*Mat=#Null
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
;-Contrôle La Validité des indexes i & j
Procedure ControleIndices(*Mat.Matrice,i,j)
If i>=1 And j>=1 And i<=*Mat\N And j<=*Mat\P
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
;-Renvoi le ième élement de la jème ligne, comme pointeur sur une valeur
Procedure.f Elt(*Mat.Matrice,i.l,j.l)
*Val.f
If ControleIndices(*Mat,i,j)
*Val=PeekF(*Mat\Addresse+((i-1)**Mat\P+(j-1))*#Reel)
Else
*Val=#Null
EndIf
ProcedureReturn *Val
EndProcedure
;-Donne la valeur Val à l'élement Mati,j
Procedure.b SetElt(*Mat.Matrice,i.l,j.l,Val.f)
If ControleIndices(*Mat,i,j)
PokeF(*Mat\Addresse+((i-1)**Mat\P+(j-1))*#Reel,Val)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
;-transfert de A dans B
Procedure.b TransfertMatrice(*A.Matrice,*B.Matrice)
If TestMatrice(*A,#TOUTE) And TestMatrice(*B,#TOUTE) And *A\N=*B\N And *A\P=*B\P
CopyMemory(*A\Addresse,*B\Addresse,*A\N**A\P*#Reel)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
;-Copie A dans B qui est créée renvoyé comme pointeur
Procedure.b CopyMatrice(*A.Matrice,*B.Matrice)
If TestMatrice(*A,#TOUTE)
*B=InitMatrice(*A\N,*A\P)
If TestMatrice(*B,#TOUTE)
CopyMemory(*A\Addresse,*B\Addresse,*A\N**A\P*#Reel)
ProcedureReturn *B
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Extrait La colonne i et la ligne j de la matrice *Mat renvoie une matrice d'ordre inférieur
Procedure ExtractMatrice(*Mat.Matrice,i.l,j.l)
k.l
l.l
If TestMatrice(*Mat,#TOUTE) And ControleIndices(*Mat,i,j)
If *Mat\N>=2 And *Mat\P>=2
*Extrait.Matrice=InitMatrice(*Mat\N-1,*Mat\P-1)
For k=1 To *Mat\N
For l=1 To *Mat\P
If k<i
If l<j
SetElt(*Extrait,k,l,Elt(*Mat,k,l))
Else
If l>j
SetElt(*Extrait,k,l-1,Elt(*Mat,k,l))
EndIf
EndIf
EndIf
If k>i
If l<j
SetElt(*Extrait,k-1,l,Elt(*Mat,k,l))
Else
If l>j
SetElt(*Extrait,k-1,l-1,Elt(*Mat,k,l))
EndIf
EndIf
EndIf
Next l
Next k
ProcedureReturn *Extrait
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Renvoie la transposé d'une matrice
Procedure TransposeMatrice(*Mat.Matrice)
k.l
l.l
If TestMatrice(*Mat,#TOUTE)
*Transpose.Matrice=InitMatrice(*Mat\P,*Mat\N)
If *Transpose
For i=1 To *Transpose\N
For j=1 To *Transpose\P
SetElt(*Transpose,i,j,Elt(*Mat,j,i))
Next j
Next i
ProcedureReturn *Transpose
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Renvoie le produit de Deux Matrices
Procedure ProduitMatrice(*A.Matrice,*B.Matrice)
If TestMatrice(*A,#TOUTE) And TestMatrice(*B,#TOUTE) And *A\N=*B\P
i.l
j.l
k.l
Val.f
*C.Matrice=InitMatrice(*B\N,*A\P)
If *C
For j=1 To *A\P
For i=1 To *B\N
Val=0
For k=1 To *A\N
Val=Val+Elt(*A,k,j)*Elt(*B,i,k)
Next k
SetElt(*C,i,j,Val)
Next i
Next j
ProcedureReturn *C
Else
ProcedureReturn#Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Multiplie l'ensemble de la Matrice par Val
Procedure MatriceFois(*A.Matrice,Val.f)
i.l
j.l
If TestMatrice(*A,#TOUTE)
*B.Matrice=InitMatrice(*A\N,*A\P)
If *B
For j=1 To *A\P
For i=1 To *A\N
SetElt(*B,i,j,Elt(*A,i,j)*Val)
Next i
Next j
ProcedureReturn *B
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Ajoute Val à l'ensemble de la Matrice
Procedure MatricePlus(*A.Matrice,Val.f)
i.l
j.l
If TestMatrice(*A,#TOUTE)
*B.Matrice=InitMatrice(*A\N,*A\P)
If *B
For j=1 To *A\P
For i=1 To *A\N
SetElt(*B,i,j,Elt(*A,i,j)+Val)
Next i
Next j
ProcedureReturn *B
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-Calcul le Déterminant d'une matrice
Procedure.f Determinant(*Mat.Matrice)
Protected i.l
Protected j.l
Protected Det.f
Protected Element.f
Protected DetPlus.f
Protected Dimension.l
j=1
Det=0.0
If TestMatrice(*Mat,#CARRE)
Dimension=*Mat\N
Select Dimension
Case 1
Det=Elt(*Mat,1,1)
Case 2
Det=Elt(*Mat,1,1)*Elt(*Mat,2,2)-Elt(*Mat,1,2)*Elt(*Mat,2,1)
Default
For i=1 To Dimension
*Mineur.Matrice=ExtractMatrice(*Mat,i,j)
If TestMatrice(*Mineur,#CARRE)
Element=Elt(*Mat,i,j)
DetPlus=Determinant(*Mineur)
Det=Det+Element*Pow(-1,i+j)*DetPlus
FreeMatrice(*Mineur)
EndIf
Next i
EndSelect
Else
Det=0
EndIf
ProcedureReturn Det
EndProcedure
;-Calcul l'inverse d'une matrice
;l'inverse d'une matrice est la transposée de la comatrice, matrice des cofacteurs,divisé par le déterminant
;Inv(A)=adj(A)/det(A) adj(A)=transposé(Matrice des cofacteurs=(-1)E(i+j)*Determinant(A-colonne i-ligne j)
Procedure InverseMatrice(*Mat.Matrice)
Protected i.l
Protected j.l
Protected Dimension.l
Protected Det.f
Protected DetMineur.f
Protected Element.f
If TestMatrice(*Mat,#CARRE)
Dimension=*Mat\N
Det=Determinant(*Mat)
If Det
*Inv.Matrice=InitMatrice(Dimension,Dimension)
If Dimension=1
SetElt(*Inv,1,1,1/Elt(*Mat,1,1))
Else
For j=1 To Dimension
For i=1 To Dimension
*Mineur.Matrice=ExtractMatrice(*Mat,i,j)
DetMineur=Determinant(*Mineur)
Element=Pow(-1,i+j)*DetMineur/Det
SetElt(*Inv,j,i,Element)
FreeMatrice(*Mineur)
Next i
Next j
EndIf
ProcedureReturn *Inv
Else
ProcedureReturn #Null
EndIf
Else
ProcedureReturn #Null
EndIf
EndProcedure
;-*********************************************************************
;-****** calcul Vectoriel
;-*********************************************************************
;-Libère un vecteur 3D
Procedure FreeVecteur3D(*Vect.Vecteur3D)
FreeMemory(*Vect)
EndProcedure
;-Affiche un vecteur 3D dans le Debugger
Procedure AfficheVecteur3D(*Vect.Vecteur3D)
Debug *Vect\x
Debug *Vect\y
Debug *Vect\z
EndProcedure
;-Calcul le Produit d'une Matrice 3,3 par un vecteur 3D, renvoie un vecteur 3D
Procedure MatriceVecteur3D(*Mat.Matrice,*Vect.Vecteur3D)
*VectRes.Vecteur3D=AllocateMemory(3*#Reel)
If TestMatrice(*Mat,#CARRE)=3
*VectMat.Matrice=InitMatrice(1,3)
CopyMemory(*Vect,*VectMat\Addresse,#Reel*3)
; AfficheMatrice(*VectMat)
*VecResMat.Matrice=ProduitMatrice(*Mat,*VectMat)
CopyMemory(*VecResMat\Addresse,*VectRes,#Reel*3)
FreeMatrice(*VecResMat)
ProcedureReturn *VectRes
Else
FreeMemory(*VectRes)
ProcedureReturn #Null
EndIf
EndProcedure
;-calcul la couleur complementaire d'un vecteur 3D
Procedure Complementaire3D(*Coul.Vecteur3D,*Comp.Vecteur3D)
*Comp.Vecteur3D
*Comp\x=255-*Coul\x
*Comp\y=255-*Coul\y
*Comp\z=255-*Coul\z
EndProcedure
;-Calcul la Norme D'un Vecteur 3D
Procedure.f NormeVecteur3D(*Vect.Vecteur3D)
Norm2.f = (*Vect\x) * (*Vect\x) + (*Vect\y) * (*Vect\y) + (*Vect\z) * (*Vect\z)
Norm.f = Sqr(Norm2)
ProcedureReturn Norm
EndProcedure
;-Calcul le vecteur liant deux points resultat dans *Vect
Procedure CalculVecteur3D(*Vect.Vecteur3D,*P1.Vecteur3D,*P2.Vecteur3D)
*Vect\x=*P2\x-*P1\x
*Vect\y=*P2\y-*P1\y
*Vect\z=*P2\z-*P1\z
EndProcedure
;-Donne la distance entre deux point
Procedure DistanceEntrePoint(*P1.Vecteur3D,*P2.Vecteur3D)
Protected Dist.f
Protected Vecteur.Vecteur3D
CalculVecteur3D(@Vecteur.Vecteur3D,*P1.Vecteur3D,*P2.Vecteur3D)
Dist=NormeVecteur3D(@Vecteur)
ProcedureReturn Dist
EndProcedure
;-Normalise un Vecteur3D par Sa norme exposant 5/2
Procedure BiNormalisationVecteur3D(*Vect.Vecteur3D)
Norm.f = NormeVecteur3D(*Vect)
sNorm.f=(Sqr(Norm))
If Norm = 0
*Vect\x = 0
*Vect\y = 0
*Vect\z = 0
Else
*Vect\x = *Vect\x / Norm/Norm/sNorm
*Vect\y = *Vect\y / Norm/Norm/sNorm
*Vect\z = *Vect\z / Norm/Norm/sNorm
EndIf
EndProcedure
;-Normalise un vecteur3D
Procedure.f NormalisationVecteur3D(*Vect.Vecteur3D)
Norm.f = NormeVecteur3D(*Vect)
If Norm = 0
*Vect\x = 0
*Vect\y = 0
*Vect\z = 0
Else
*Vect\x = *Vect\x / Norm
*Vect\y = *Vect\y / Norm
*Vect\z = *Vect\z / Norm
EndIf
ProcedureReturn Norm
EndProcedure
;-Multiplie un vecteur3D de manière à ramener sa composante Maximale=Val
Procedure MaximizeVecteur3D(*Vect.Vecteur3D,Val.f)
Protected Max.f
Max=*Vect\x
If *Vect\y>Max : Max=*Vect\y : EndIf
If *Vect\z>Max : Max=*Vect\z : EndIf
If Max>0
*Vect\x=*Vect\x/Max*Val
*Vect\y=*Vect\y/Max*Val
*Vect\z=*Vect\z/Max*Val
EndIf
EndProcedure
;-Normalise un vecteur par la somme de ses composantes
Procedure SommeUnVecteur3D(*Vect.Vecteur3D)
Somme.f=*Vect\x+*Vect\y+*Vect\z
If Somme
*Vect\x=*Vect\x/Somme
*Vect\y=*Vect\y/Somme
*Vect\z=*Vect\z/Somme
EndIf
EndProcedure
;-Conbine Deux Vecteur renvoi un pointeur sur vecteur
Procedure CombinaisonVecteur3D(Val1.f,*Vect1.Vecteur3D,Val2.f,*Vect2.Vecteur3D)
*Somme.Vecteur3D=AllocateMemory(SizeOf(Vecteur3D))
*Somme\x=Val1**Vect1\x+Val2**Vect2\x
*Somme\y=Val1**Vect1\y+Val2**Vect2\y
*Somme\z=Val1**Vect1\z+Val2**Vect2\z
ProcedureReturn *Somme
EndProcedure
;-Conbine Deux Vecteur resultat par paramètre dans somme
Procedure CombinaisonVecteur3DEx(Val1.f,*Vect1.Vecteur3D,Val2.f,*Vect2.Vecteur3D,*Somme.Vecteur3D)
*Somme\x=Val1**Vect1\x+Val2**Vect2\x
*Somme\y=Val1**Vect1\y+Val2**Vect2\y
*Somme\z=Val1**Vect1\z+Val2**Vect2\z
EndProcedure
;-donne un point sur une droite- val=0:Pointdeb val=1:PointFin, resultat dans *res
Procedure PointSurDroiteEx(*PointDeb.Vecteur3D,*PointFin.Vecteur3D,Val.f,*Res.Vecteur3D)
*Res\x=*PointDeb\x+Val*(*PointFin\x-*PointDeb\x)
*Res\y=*PointDeb\y+Val*(*PointFin\y-*PointDeb\y)
*Res\z=*PointDeb\z+Val*(*PointFin\z-*PointDeb\z)
EndProcedure
;-Egalise deux vecteur3D
Procedure EgaliseVecteur3D(*Source.Vecteur3D,*Dest.Vecteur3D)
*Dest\x=*Source\x
*Dest\y=*Source\y
*Dest\z=*Source\z
EndProcedure
;-Ajoute un vecteur 3D à une somme
Procedure SommeVecteur3D(*Somme.Vecteur3D,Val.f,*Vect.Vecteur3D)
*Somme\x=*Somme\x+Val**Vect\x
*Somme\y=*Somme\y+Val**Vect\y
*Somme\z=*Somme\z+Val**Vect\z
EndProcedure
;-Multiplie un vecteur3D par Val
Procedure Vecteur3DFois(*Vect.Vecteur3D,Val.f)
*Vect\x=*Vect\x*Val
*Vect\y=*Vect\y*Val
*Vect\z=*Vect\z*Val
EndProcedure
;-Calcul le scalaire de deux vecteurs 3D
Procedure.f Scalaire3D(*A.Vecteur3D,*B.Vecteur3D)
Scalaire.f
Scalaire=*A\x**B\x+*A\y**B\y+*A\z**B\z
ProcedureReturn Scalaire
EndProcedure
;-Signe de rotation entre vecteur
Procedure.l SigneRotationOZ(*A.Vecteur3D,*B.Vecteur3D)
Res.l
rot.f=*A\x**B\y-*A\y**B\x
If rot>0:Res=1:EndIf
If rot=0:Res=0:EndIf
If rot<0:Res=-1:EndIf
ProcedureReturn Res
EndProcedure
;-Rotation d'un vecteur 3D autour de l'axe Z, Angle en Degrés
Procedure.f Rotation3DZ(*A.Vecteur3D,ANGLE.f)
rad.f=2*#Pi/360*ANGLE
*Rot=InitMatrice(3,3)
SetElt(*Rot,1,1,Cos(rad))
SetElt(*Rot,2,1,-Sin(rad))
SetElt(*Rot,3,1,0)
SetElt(*Rot,1,2,Sin(rad))
SetElt(*Rot,2,2,Cos(rad))
SetElt(*Rot,3,2,0)
SetElt(*Rot,1,3,0)
SetElt(*Rot,2,3,0)
SetElt(*Rot,3,3,1)
*VectRes=MatriceVecteur3D(*Rot,*A)
ProcedureReturn *VectRes
EndProcedure
;-Renvoi le vecteur unitaire faisant un angle donné en ° dans le cercle trigo
Procedure VecteurTrigo(ANGLE.f)
OX.Vecteur3D
OX\x=1
OX\y=0
OX\z=0
*VectRes=Rotation3DZ(@OX,ANGLE)
ProcedureReturn *VectRes
EndProcedure
;-Renvoi le vecteur unitaire faisant un angle donné en ° dans le cercle trigo par parametre
Procedure VecteurTrigoEx(ANGLE.f,*VectRes.Vecteur3D)
OX.Vecteur3D
OX\x=1
OX\y=0
OX\z=0
*Res=Rotation3DZ(@OX,ANGLE)
EgaliseVecteur3D(*Res,*VectRes)
FreeMemory(*Res)
EndProcedure
;-Calcul le scalaire de deux vecteurs 2D
Procedure.f Scalaire2D(*A.Vecteur2D,*B.Vecteur2D)
Scalaire.f
Scalaire=*A\x**B\x+*A\y**B\y
ProcedureReturn Scalaire
EndProcedure
;-calcul l'intersection de deux droites dans le plan OXY défini par un point et un vecteur directeur
;-Resultat dans *Res
Procedure.l IntersectionDroite(*P1.Vecteur3D,*D1.Vecteur3D,*P2.Vecteur3D,*D2.Vecteur3D,*Res.Vecteur3D)
Val.f=*D1\x**D2\y-*D1\y**D2\x
If Val<>0
*Res\x=(*D1\x**D2\y**P2\x-*D2\x**D1\y**P1\x+(*P1\y-*P2\y)**D1\x**D2\x)/Val
*Res\y=-(*D1\y**D2\x**P2\y-*D2\y**D1\x**P1\y+(*P1\x-*P2\x)**D1\y**D2\y)/Val
*Res\z=0
ProcedureReturn Val
Else
*Res\x=0
*Res\y=0
*Res\z=0
EndIf
EndProcedure
;-******************************************************
;-Polaire 2D
;-******************************************************
;-Donne les coordonnées réelles d'un point à partir d'un centre, d'un focus, et de coordonnées polaires
Procedure PolaireToXY(*Pol.Polaire2D,*Centre.Vecteur3D,Focus.f,*Res.Vecteur3D)
Protected ANGLERad.f
ANGLERad.f=*Pol\ANGLE*#Pi/180
*Res\z=0
*Res\x=*Centre\x+*Pol\Rayon*Focus*Cos(ANGLERad)
*Res\y=*Centre\y+*Pol\Rayon*Focus*Sin(ANGLERad)
EndProcedure
;-donne les coordonnées polaires d'un point
Procedure XYtoPolaire(*P1.Vecteur3D,*ResPolaire.Polaire2D)
Protected distance.f
*P1\z=0
distance=NormeVecteur3D(*P1)
*ResPolaire\Rayon=distance
If distance
If *P1\y>=0
*ResPolaire\ANGLE=180/#Pi*ACos(*P1\x/distance)
Else
*ResPolaire\ANGLE=360-180/#Pi*ACos(*P1\x/distance)
EndIf
Else
*ResPolaire\ANGLE=0
EndIf
;Message$="P1:"+StrF(*P1\x,2)+","+StrF(*P1\y,2)+","+StrF(*P1\z,2)+"Polaire2D:"+StrF(distance)+","+StrF(*ResPolaire\ANGLE,2))
;Debug Message$
EndProcedure
;-******************************************************
;-Polaire 3D
;-******************************************************
;-ramène l'angle dans 0,360°
Procedure.l RecalPolaire(*Pol.Polaire3D)
Protected Res.l
Res=1
If r<0 Or r>1
Res=0
Else
*Pol\Teta=Modulo(*Pol\Teta,360)
*Pol\Fi=Modulo(*Pol\Fi,360)
EndIf
ProcedureReturn Res
EndProcedure
;-Affiche les coordonnées polaires dans le debugger
Procedure AffichePolaire(*Pol.Polaire3D)
Message$="(r,Teta,Fi)"+StrF(*Pol\Rayon,3)+","+StrF(*Pol\Teta,3)+","+StrF(*Pol\Fi,3)
Debug Message$
EndProcedure