Librairie : Math et Calcul Matriciel

Partagez votre expérience de PureBasic avec les autres utilisateurs.
barnierchristophe
Messages : 64
Inscription : lun. 07/févr./2005 11:18

Librairie : Math et Calcul Matriciel

Message par barnierchristophe »

:idea: Voilà une petite librairie qui pourra servir à certains d'entre vous.
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 :
:idea: un exemple succint d'utilisation:

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
:idea: La Librairie "CalculMatriciel.pb"

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
Dernière modification par barnierchristophe le ven. 09/déc./2005 22:12, modifié 2 fois.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Il existe un excellent soft de Dobro pour mettre en couleur le code sur le forum, c'est COLORER
Sinon il y a le bouton "Code" dans les options de message.
Là je trouve que c'est lourd à digérer alors que ta lib est certainement très intéressante.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
barnierchristophe
Messages : 64
Inscription : lun. 07/févr./2005 11:18

Message par barnierchristophe »

C'est Fait.
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

J'ai pas encore tout passé au crible, mais pour ta fonction exponentielle tu pourrais essayer ceci :

Code : Tout sélectionner

Procedure.f Exp(x.f)
  Protected r.f, t.f, i.f
 
  If x >= 0
    r = 1.0
    t = 1.0
   
    While t
      i + 1.0
      t * x / i
      r + t
    Wend
  Else
    r = 1/Exp(-x)
  EndIf
 
  ProcedureReturn r
EndProcedure 
Dri ;)
Heis Spiter
Messages : 1092
Inscription : mer. 28/janv./2004 16:22
Localisation : 76
Contact :

Message par Heis Spiter »

Un des problèmes de ta lib est que tu pars du principe que le repère est orthonormé : ça limite beaucoup.

Jete un oeil à ma lib, si tu veux :oops:.
Heis Spiter, webmaster du site http://www.heisspiter.net
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL :D
barnierchristophe
Messages : 64
Inscription : lun. 07/févr./2005 11:18

Message par barnierchristophe »

Pour Dr Dri
J'avais essayé cette approximation, qui n'étais pas toujours très fiable; et puis c'est un peu lent

Pour Heis Spiter
J'ai pas trouvé ta librairie
Heis Spiter
Messages : 1092
Inscription : mer. 28/janv./2004 16:22
Localisation : 76
Contact :

Message par Heis Spiter »

Heis Spiter, webmaster du site http://www.heisspiter.net
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL :D
barnierchristophe
Messages : 64
Inscription : lun. 07/févr./2005 11:18

Message par barnierchristophe »

J'ai regardé ta librairie. Ce que je propose est différent il me semble, en particulier pour la manipulation de matrices de toutes dimensions : somme, produit, inversion ect
Heis Spiter
Messages : 1092
Inscription : mer. 28/janv./2004 16:22
Localisation : 76
Contact :

Message par Heis Spiter »

Je te parlais au nioveau vectoriel, tu y es limité. Les matrices, effectivement je ne fais pas.
Heis Spiter, webmaster du site http://www.heisspiter.net
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL :D
Répondre