Matrix Class

[aloberoger]

vector.bi[/b

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"
#Include Once "win/Ole2.bi"
#Include Once "crt/math.bi"
 
Type Vector
	Public:
	   Declare Constructor()
	   Declare Constructor (Size As Integer,value As Double=0#)
	   Declare Constructor (value() As Double)
	   Declare Constructor (ByRef value As Vector)
	   Declare Destructor
	   Declare Property Size() As Integer
	   Declare Property Lenght() As Integer
	   
	   Declare Operator [](index As Integer)ByRef As Double
	   Declare Function at(index As Integer)ByRef As Double
	    
	   Declare Operator Let(v As vector)
	   Declare Operator Let(ByVal value As Double)
      Declare Function toString(ivertically As Integer=0)As String
	   Declare Operator Cast() As String
	  	Private:
	   ReDim Arr(0 To -1) As Double
	   As Integer m_lowbound=1 
      As Integer m_Highbound
End Type


   
   

 Constructor Vector()
   
 End Constructor
 
  Constructor Vector(_Size As Integer,value As Double=0#)
    m_Highbound=_Size
    ReDim Arr(1 To m_Highbound)
    If _Size   Then 
       For i As Integer=  1 To _Size 
 		   Arr(i)=value 
       Next 
    End If   
  End Constructor
  
  Constructor Vector( value() As Double)
      m_Highbound=UBound(value)
      ReDim Arr(1 To UBound(value))
       If UBound(value)   Then 
       For i As Integer=  1 To UBound(value) 
 		   Arr(i)=value(i)
       Next 
       End If
  End Constructor
  
  Constructor Vector(ByRef value As Vector)
      this.constructor(value.Size )
       If value.Size   Then 
       For i As Integer=  1 To value.Size 
 		   Arr(i)=value[i]
       Next 
       End If
  End Constructor
   
 Destructor Vector
    Erase Arr
 End Destructor
 
 
  
 
  Property Vector.Size() As Integer 
    Return UBound(Arr)-LBound(Arr)+1
 End Property
 
 Property Vector.Lenght() As Integer
    Return UBound(Arr)-LBound(Arr)+1
 End Property
 
   
	   
 Operator Vector.[](index As Integer)ByRef As Double
 	 If index<1 Or index>this.Size Then
 	 	Messagebox NULL , "L'indice est en dehors de la plage (" & index & ")" ,"erreur dans Vector.[]",MB_ICONERROR
 	   Exit Operator
 	 EndIf
 	  Return Arr(index)
 End Operator
 
 Function Vector.at(index As Integer) ByRef As Double
 	 If index<1 Or index>this.Size Then
 	 	Messagebox NULL , "L'indice est en dehors de la plage (" & index & ")" ,"erreur dans Vector.at",MB_ICONERROR
 	   Exit Function
 	 EndIf
 	  Return Arr(index)
 End Function

  
 
 Operator Vector.Let(v As vector)
 	ReDim Arr(1 To v.Size)
 	For i As Integer= 1 To v.Size 
 		Arr(i)=v[i]
 	Next
 End Operator
 
 Operator Vector.Let(byval value As Double)
 	 If Size=0 Then Return
 	 For i As Integer= LBound(Arr)  To UBound(Arr) 
 		 	Arr(i)=value
 	 Next
 End Operator
 
  
 

 
  
 Function Vector.toString(ivertically As Integer=0) As String
    If Size=0 Then Return "Is empty"
    Dim as String sOut 
    If ivertically=0 Then 
        for  i  As Integer= LBound(Arr,1) To UBound(Arr,1)
             sout+=(Format(Arr(i),"####0.00")+ " ") 
        Next i
    Else
        For  i  As Integer= LBound(Arr,1) To UBound(Arr,1)
             sout+= Format(Arr(i),"####0.00")+ Chr(13,10) 
        Next i
    End If    
   return sout 
  End Function
 
    
   Operator Vector.Cast() As String
   	Return this.toString
   End Operator
   
  
  
  
 
  
 
 

 
 
 Operator + (ByRef v1 As Vector,ByRef v2 As Vector) As Vector
 	Dim v As Vector=vector(Max(v1.Size,v2.Size))
 	For i As Integer=1 To Max(v1.Size,v2.Size)
 		v[i]=v1[i]+v2[i]
 	Next
 	Return v
 End Operator
 
 Operator +( d As Double, v  As Vector) As Vector
 	Dim vv As Vector=Vector(v)
 	For i As Integer=  1 To  v.Size
 		vv[i]=v[i]+d
 	Next
 	Return vv
 End Operator
 
 Operator - (ByRef v1 As Vector,ByRef v2 As Vector) As Vector
 	Dim v As Vector=vector(Max(v1.Size,v2.Size))
 	For i As Integer=1 To Max(v1.Size,v2.Size)
 		v[i]=v1[i]-v2[i]
 	Next
 	Return v
 End Operator
 
 Operator -( d As Double, v  As Vector) As Vector
 	Return (-d)+v
 End Operator
 
 Operator * (ByRef v1 As Vector,ByRef v2 As Vector) As Vector
 	Dim v As Vector=vector( Max(v1.Size,v2.Size))
 	For i As Integer=1 To Max(v1.Size,v2.Size)
 		v[i]=v1[i]*v2[i]
 	Next
 	Return v
 End Operator
 
 Operator * ( n As Integer, v  As Vector) As Vector
 	Dim vv As Vector=Vector(v)
 	For i As Integer=  1 To  v.Size
 		vv[i]=v[i]*n
 	Next
 	Return vv
 End Operator
 
 Operator * ( v  As Vector, n As Integer) As Vector
 	Return n*v
 End Operator
 
 Operator - ( v As Vector) As Vector
 	Dim vv As Vector=Vector(v)
 	For i As Integer=  1 To v.Size
 		vv[i]=-v[i]
 	Next
 	Return vv
 End Operator
 
 Operator ^ ( v1 As Vector, v2 As Vector) As Vector
 	Return v1*v2
 End Operator
 
 Operator ^ ( v As Vector, d As Double) As Vector
 	Dim vv As Vector=Vector(v)
 	For i As Integer=  1 To v.Size
 		vv[i]= v[i]^d
 	Next
 	Return vv
 End Operator
 
 Operator =(v1  As Vector,v2  As Vector) As BOOL
	Dim flag As BOOL
	If  v1.Size=v2.Size Then
	   For i As Integer=  1  To v1.Size  
 		 	If v1[i] <> v2[i] Then
 		 	  Return FALSE
 		 	Else
 		 	  flag=CTRUE
 		 	EndIf
	   Next  
	EndIf
	Return flag      
End Operator

Operator =(v  As Vector,value As Double) As BOOL
  	For i As Integer= 1  To v.Size 
  		If v[i] <> value Then
 		 	Return FALSE
  		EndIf
  	Next  
 Return CTRUE   
End Operator

 
 


 Function ArrayToVector(a() As Double) As Vector
 	Dim v  As Vector=Vector(UBound(a))
 	For i As Integer= 1 To UBound(a) 
 		v[i]=a(i)
 	Next
 	Return v
 End Function
 
  Function  SORT  (a As Vector,ASCEND_direction As BOOL=CTRUE ) As Vector
 
 Dim As integer  i
 Dim As integer  j
 Dim  As Double s 
 
 Dim res As Vector=a
   
 If ASCEND_direction Then ASCEND_direction=1 
 Select Case ASCEND_direction 
 	Case 1

  For i = 1 To res.Size
   For j = i+1 To res.Size
      if (res[j]< res[i]) Then     
        	s=res[i]
      	res[i]=res[j]
      	res[j]=s
      	
      end if

   Next j

  Next i
 	Case 0
 		For i = 1 To res.Size
        For j = i+1 To res.Size
           if ( res[j] >  res[i]) Then
      	      	s=res[i]
      	         res[i]=res[j]
      	         res[j]=s
           end if
         Next j
      Next i
 End Select 
 Return res
End Function

Matrix.bi

Code: Select all

#Include Once "vector.bi"

Type Matrix
 	Public:
 	   Declare Constructor()
	   Declare Constructor (Highbound1 As Integer,Highbound2 As Integer)
	   Declare Destructor
       Declare Property Rows(value As Integer) ' set the number of rows
	   Declare Property Rows() As Integer       ' returns the number of rows
      Declare Property Cols(value As Integer)  ' set the number of columns
      Declare Property Cols()  As Integer  ' returns the number of columns
      Declare Operator [](irow As integer)ByRef As vector
	   Declare Function at(irow As Integer,icol As Integer) ByRef As Double 

	    Declare Operator Let(ByRef m As  Matrix)
	    Declare Operator Let(byval value As Double)
	    
	     Declare Operator Cast() As String
 
 	Private:
 	  ReDim Arr(0 To -1) As Vector
 	  m_lowbound(1 To 2) As Integer
     m_Highbound(1 To 2)As Integer
 End Type

Constructor  Matrix()
     ReDim  Arr(0 To -1)
End Constructor

Destructor Matrix()
  Erase Arr
End Destructor

  Constructor  Matrix (Highbound1 As Integer,Highbound2 As Integer)
      ReDim Arr(1 To Highbound1)
      For i As Integer=1 To Highbound1
          Arr(i)=vector(Highbound2)
      Next i
       m_lowbound(1)=1 :m_lowbound(2)=1
       m_Highbound(1)=Highbound1: m_Highbound(2)=Highbound2
  End Constructor
  
  Property Matrix.Rows(value As Integer) ' set the number of rows
      m_Highbound(1)=value  ': m_Highbound(2)=this.Cols sinon 
      ReDim Arr(1 To  m_Highbound(1))
      For i As Integer=1 To m_Highbound(1)
          Arr(i)=vector(m_Highbound(2))
      Next i
  End Property
 
  Property Matrix.Rows() As Integer ' returns the number of rows
    return UBound(Arr,1)-LBound(Arr,1) +1 
  End Property
 
  Property Matrix.Cols(value As Integer)   ' set the number of columns
   m_Highbound(2)=value     ':m_Highbound(1)=this.Rows: sinon erreur  
   ReDim Arr(1 To  m_Highbound(1))
      For i As Integer=1 To m_Highbound(1)
          Arr(i)=vector(m_Highbound(2))
      Next i  
  End Property
  
  Property Matrix.Cols()  As Integer  ' returns the number of columns
    return m_Highbound(2)-LBound(Arr,1)  +1 
  End Property

   Operator Matrix.[](irow As integer)ByRef As vector
   	  Return Arr(irow)
   End Operator
   
   Function Matrix.at(irow As Integer,icol As Integer) ByRef As Double
 	 If irow<1 Or irow>m_Highbound(1) _
    	Or icol<1 Or icol>m_Highbound(2) Then  
    	Messagebox NULL , "Les indices sont en dehors de la plage (" & irow & ";" & icol & ")" ,"erreur dans Matrix.at",MB_ICONERROR
    	Exit Function
    EndIf
     Return Arr(irow)[icol]
   End Function
   
   Operator  Matrix.Let(ByRef  m As Matrix)
 	if(@this <> @m) Then 'assignation M = M impossible
 	This.constructor( m.m_Highbound(1), m.m_Highbound(2))
 	For i As Integer= 1   To UBound(Arr,1) 
 		 For j As Integer= 1  To  Arr(i).Size
 		 	Arr(i)[j]=m.at(i,j)
 		 Next
 	Next
 	End If
 End Operator
 
 Operator  Matrix.Let(byval value As Double)
 	 For i As Integer= 1   To UBound(Arr,1) 
 		 For j As Integer= 1  To Arr(i).Size
 		 	Arr(i)[j]=value
 		 Next
 	Next
 End Operator
 
 Operator Matrix.cast() As String 
   Dim as String sOut
    For  i  As Integer= 1  To UBound(Arr,1)
      For   j  As Integer= 1  To  Arr(i).Size
         Dim as Double value = Arr(i)[j] 
         sout +=" " 
         sout+=("    " +  Format(value,"####0.0000")) 
      Next j
      sOut += (!"\n") 
   Next i
   Return sout 
 End Operator
 
 
 ' write differents operators heare
 
 
 Function Eye OverLoad (ByVal n As Integer) As Matrix ' Creates a new Identity matrix.
			Dim As Matrix buf = Matrix(n, n)
			for i As Integer = 1 To  n
			  For j As Integer  = 1 To n
				  If i=j Then buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
		End Function

    Function Eye OverLoad (ByVal n As Integer,ByVal m As Integer) As Matrix ' Creates a new Identity matrix.
			Dim As Matrix buf = Matrix(n, m)
			for i As Integer = 1 To  n
			  For j As Integer  = 1 To m
				  If i=j Then buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
    End Function
    
		Function Zeros OverLoad (ByVal m As Integer, ByVal n As Integer) As Matrix ' Creates row by n matrix filled with zeros.
			Return  Matrix(m, n)
		End Function

		Public   Function Zeros(ByVal n As Integer) As Matrix  ' Creates n by n matrix filled with zeros.
			Return  Matrix(n,n)
		End Function


		  Function Ones OverLoad (ByVal m As Integer, ByVal n As Integer) As Matrix ' Creates m by n matrix filled with ones.
			Dim As Matrix buf = Matrix( m,n)
			for i As Integer = 1 To  m
			  For j As Integer  = 1 To n
				  buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
		End Function

      
		 Function Ones(ByVal n As Integer) As Matrix ' Creates n by n matrix filled with ones.
			Dim As Matrix buf = Matrix(n,n)
			for i As Integer = 1 To n
			  For j As Integer  = 1 To n
				  buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
		End Function

  Function Transpose(m As Matrix)As Matrix
  	  Dim t As Matrix=Matrix(m.cols,m.rows)
  	  For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
  	  	        t[i][j]=m[j][i]
 		 Next j
	  Next i 
  	  
  	  Return t
  End Function

Operator + (m1 As Matrix,m2 As Matrix) As Matrix
	Dim As Matrix m=Matrix(m1)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)=m1.at(i,j)+ m2.at(i,j) 
 		 Next
	Next 
	Return m
End Operator

Operator + (m1 As Matrix,d As Double) As Matrix
	Dim As Matrix m=Matrix(m1)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)=m1.at(i,j)+d 
 		 Next
	Next 
	Return m
End Operator

Operator + (d As Double ,m1 As Matrix) As Matrix
	Return (m1+d)
End Operator

Operator - (m1 As Matrix,m2 As Matrix) As Matrix      ' subtraction of Matrix with Matrix
	Dim As Matrix m=Matrix(m1)
	' check if the dimensions match
   If (m1.rows = m2.rows And m1.cols = m2.cols) then
   	
	  For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m[i][j]=m1[i][j]-m2[i][j]
 		  Next
	   Next 
	   
   End If   
	  Return m
End Operator

 Operator - (m As Matrix) As Matrix      ' minus of Matrix with Matrix 
  Dim As Matrix m2=Matrix(m)
	For i As Integer= 1 To m2.Rows 
 		 For j As Integer= 1 To m2.Cols
 		 	 m2[i][j]= -m[i][j]
 		 Next
	Next 
	Return m2
 End Operator
 
Operator - (d As Double,m2 As Matrix) As Matrix
	Dim As Matrix m=Matrix(m2)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)= d-m2.at(i,j) 
 		 Next
	Next 
	Return m
End Operator

Operator - (m2 As Matrix,d As Double) As Matrix
	Return (-d+m2)
End Operator
 
 Private Function matmul OverLoad (m1 As Matrix,m2 As Matrix) As Matrix
 If (M1.cols <> M2.rows)Then
 	Messagebox Getactivewindow(),"Revoir les bornes des Matrix m1 et m2","Matmul impossible",MB_ICONERROR
 	Return Matrix()
 EndIf
 Dim m3 As Matrix=Matrix( m1.Rows, m2.Cols)
 Dim As Double DSUM
 For  I As Integer=1 to m1.Rows
  For J  As Integer=1 to m2.Cols
   DSUM=0.00
   For K  As Integer=1 to m1.Cols 
     DSUM=DSUM+m1.at(I,K)*m2.at(K,J)
   Next K
    m3.at(I,J)=DSUM 
  Next j
 Next i
Return m3
End Function

 Operator * (A As Matrix,B As Matrix) As Matrix
	Return matmul(A,B)
End Operator

 
Operator * (m1 As Matrix,v As vector) As Vector    'Y(M)=A(M,N)*X(N)
 If (m1.cols<> v.size)  Then
	Messagebox Getactivewindow(),"Revoir les bornes de la Matrix m1 et du vecteur","Multiplication matrice-vecteur impossible",MB_ICONERROR
	Return Vector()
EndIf
 Dim Y As Vector=Vector(m1.Rows)
  Dim As Double  dSum=0.0D+00
  For i As Integer =1 To m1.Rows
    dSum = 0.0D+00
    For j As Integer = 1 To m1.cols
      dSum = dSum + m1.at(i,j) * v[j]
      Y[i]=dSum
    Next j
  Next i
	Return Y
End Operator
 
Operator * (v As vector,m2 As Matrix) As Vector
	Return m2*v
End Operator

Operator * (n As Integer,m As Matrix) As Matrix
	Dim As Matrix nm=Matrix(m)
	For i As Integer= 1 To m.rows 
 		 For j As Integer= 1 To m.cols
 		 	nm.at(i,j)=n*m.at(i,j) 
 		 Next
	Next  
	Return nm
End Operator

Operator * (m As Matrix,n As Integer) As Matrix
	Return (n*m)
End Operator

 
Operator ^ (m As Matrix, n As Integer) As Matrix
 '	If n=-1 Then Return  m.inverse()
 	If n=0 Then  Return  Eye(m.rows,m.cols)
 	If n<0 Then 
 		Messagebox (Getactivewindow(),"n<0 Pas encore pris en charge","Error",MB_ICONERROR)
 		Return Matrix()
 	EndIf
 	Dim As Matrix mm=Matrix(m)
 	For i As Integer=1 To n 
 	   mm = mm*mm
   Next i
	Return mm
 End Operator

Operator \(m1 As Matrix,Y As vector) As Vector    'résolution de gauss A(M,N)*X(N)=Y(M)
 Dim X As Vector=Y
 ' m1.LINEQ(X)
	Return X
End Operator

  

Operator =(m1 As Matrix,m2 As Matrix) As BOOL
	 Dim flag As BOOL
	    
	   If   m1.Rows=m2.Rows And _
	    	   m1.cols =m2.cols Then
	       	For i As Integer= 1 To m1.Rows 
 		         For j As Integer= 1  To m1.cols 
 		 	         If m1.at(i,j) <> m2.at(i,j) Then
 		 	         	Return FALSE
 		 	         Else
 		 	           flag=CTRUE
 		 	         EndIf
 		 	         
 		         Next
  	         Next  
	 EndIf
	 Return flag      
End Operator

Operator =(m As Matrix,value As Double) As BOOL
  	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	   If m.at(i,j) <> value Then
 		 	      Return FALSE
 		 	   EndIf
 		   Next
  	Next  
 Return CTRUE   
End Operator

test1.bas

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"
#Include Once "Matrix.bas" 

#Include Once "crt.bi"


Print " MATRICES SANS CONSTRUCTORS"
  Dim M1 As Matrix '=Matrix(1,3)
 M1.Rows=1 :M1.cols=3
 M1.at(1,1)=1.00  : M1.at(1,2)=2.00   :  M1.at(1,3)=3.00
  

 
  Dim M2 As Matrix '=Matrix(3,1)
 M2.Rows=3 :M2.cols=1
 M2.at(1,1)=0.00   
 M2.at(2,1)= -1.00  
 M2.at(3,1)=2.00   
 
 Dim M  As Matrix
 
 Print "M1:"
 Print M1 
 Print
 Print "M2:"
Print M2 
Print

Print
  Print "M1*M2:  possible si M1.cols = M2.rows"
  M= M1*M2       
  Print M
  Print "M.rows= " & M.rows
  Print "M.Cols= " & M.Cols
 Print
  Print "M2*M1:"
  M= M2*M1
  Print M
  Print "M.rows= " & M.rows
  Print "M.Cols= " & M.Cols
  Print
  
Dim A As Matrix  
 A.Rows=2 : A.Cols=3
 A.at(1,1)=0.00 : a.at(1,2)=0.00 :  A.at(1,3)=0.00 
 A.at(2,1)=1.00 : A.at(2,2)=2.00:  A.at(2,3)=3.00  
  
 Dim B As Matrix '=Matrix(3,3)
 B.rows=3 :B.cols=3
 B.at(1,1)=-1.00  : B.at(1,2)=1.00   :  B.at(1,3)=0.00
 B.at(2,1)= -1.00 : B.at(2,2)=1.00  :  B.at(2,3)=-3.00
 B.at(3,1)=1.00   : B.at(3,2)=-1.00   :  B.at(3,3)=2.00 

Print "A:"
 Print A 
 Print
 Print "B:"
Print B 
Print

Print "A*B can be null with A and B not null"
  Print "A*B:"
  Print A*B          ' possible si A.cols = B.rows

   
  Print
 
  Sleep
  

[aloberoger]

personaly I prefer to use .at instead of [ ] [ ] for the matrices
for the vectors .at is raising an ambiguity.

one can add any kind of procedures containing the arrays, by adding .at example A(i, j) becomes A.at(i, j) or A[j ]

Is it preferable to put the procedures in the class or then of create independent procedures with matrix in parameters?

[dodicat]

In your types vector and matrix:
by using ReDim Arr(0 To -1) As -- you are causing an illegal function call. (Win 10) 32 and 64 bit. FreeBASIC Compiler - Version 1.05.0

If you use instead:
arr(any) as double (in vector) and arr(any) as vector(in matrix)
it ends up 0 to -1 anyway.
VIZ:

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"
#Include Once "win/Ole2.bi"
#Include Once "crt/math.bi"
 
Type Vector
   Public:
      Declare Constructor()

       ' Private:
     ' ReDim Arr(0 To -1) As Double
      arr(any) as double
      As Integer m_lowbound=1 
      As Integer m_Highbound
End Type

Constructor Vector()

 End Constructor
 dim as vector v
   print lbound(v.arr),ubound(v.arr)
 sleep 

Also a couple of other bits you redim arr(1 to something)
If something=0 then an illegal call stops the program running.
I got it going OK, but I had to insure (something) was not zero.

[aloberoger]

Good remarks, but am using WIN7 not Win10, things are ok for me, I wanted to avoid Arr(any) and things are ok, I wil take into account when publishing my professinal work done with matrix, in any way until the code is improved it is the responsability to the programmer to avoid ambiguities.
thank to you and the community can improve this work, if they want.

[fxm]

Compile with option '-exx' and you will get a runtime error 1 (illegal function call), due to 'ReDim Arr(0 To -1) As Double'.
IMHO, you are lucky that your program does not crash under Win7.

[aloberoger]

you can use any instead please

[fxm]

You must use ANY instead.

[aloberoger]

OK, it seem that the function at(i as integer)with vector is ambigius, I don't know why.
I already made templates, it seem not easy to work without changes for QSvector(string)
look at this:

[aloberoger]

with macros
QSvector

Code: Select all

#Include Once "windows.bi"

#Define QSVector(T) QSVector##T

#Macro QSVECTOR_TEMPLATE(T)
 
 Type QSVector##T
 Public:
 Declare Constructor()
 Declare Constructor (Size As Integer,value As T=0)
 Declare Constructor (value() As T)
 Declare Constructor (ByRef value As QSVector##T)
 Declare Destructor
 Declare Property Size() As Integer
 Declare Sub resize(nsize As Integer,_initial As T=0)
 Declare Property Lenght() As Integer

 Declare Operator [](index As Integer)ByRef As T
 Declare Function at(index As Integer)ByRef As T

 Declare Operator Let(v As QSVector##T)
 Declare Operator Let(ByVal value As T)
 Declare Function toString(ndec As Integer=3,ivertically As Integer=0)As String
 Declare Operator Cast() As String
 Private:
 ReDim Arr(0 To -1) As T
 As Integer m_lowbound=1
 As Integer m_Highbound
End Type





 Constructor QSVector##T()

 End Constructor

 Constructor QSVector##T(_Size As Integer,value As T=0)
 m_Highbound=_Size
 ReDim Arr(1 To m_Highbound)
 If _Size Then
 For i As Integer=1 To _Size
 Arr(i)=value
 Next
 End If
 End Constructor

 Constructor QSVector##T( value() As T)
 m_Highbound=UBound(value)
 ReDim Arr(1 To UBound(value))
 If UBound(value) Then
 For i As Integer=1 To UBound(value)
 Arr(i)=value(i)
 Next
 End If
 End Constructor

 Constructor QSVector##T(ByRef value As QSVector##T)
 this.constructor(value.Size )
 If value.Size Then
 For i As Integer=1 To value.Size
 Arr(i)=value[i]
 Next
 End If
 End Constructor

 Destructor QSVector##T
 Erase Arr
 End Destructor




 Property QSVector##T.Size() As Integer
 Return UBound(Arr)-LBound(Arr)+1
 End Property

 Sub QSVector##T.resize(nsize As Integer,_initial As T)
 m_Highbound=nsize
 ReDim Arr(1 To nsize)
 For i As Integer=1 To nsize
 Arr(i)=_initial
 Next

 End Sub
 Property QSVector##T.Lenght() As Integer
 Return UBound(Arr)-LBound(Arr)+1
 End Property



 Operator QSVector##T.[](index As Integer)ByRef As T
 If index<1 Or index>this.Size Then
 Messagebox NULL , "L'indice est en dehors de la plage (" & index & ")" ,"erreur dans QSVector.[]",MB_ICONERROR
 Exit Operator
 EndIf
 Return Arr(index)
 End Operator

 Function QSVector##T.at(index As Integer) ByRef As T
 If index<1 Or index>this.Size Then
 Messagebox NULL , "L'indice est en dehors de la plage (" & index & ")" ,"erreur dans QSVector.at",MB_ICONERROR
 Exit Function
 EndIf
 Return Arr(index)
 End Function



 Operator QSVector##T.Let(v As QSVector##T)
 ReDim Arr(1 To v.Size)
 For i As Integer=1 To v.Size
 Arr(i)=v[i]
 Next
 End Operator

 Operator QSVector##T.Let(byval value As T)
 If Size=0 Then Return
 For i As Integer=LBound(Arr) To UBound(Arr)
 Arr(i)=value
 Next
 End Operator






 Function QSVector##T.toString(ndec As Integer=3,ivertically As Integer=0) As String
 If Size=0 Then Return "Is empty"
 Dim as String sOut, sdec="####0." & String(ndec,"#")
 If this.Size=0 Then Return "Is empty"
    If ivertically=0 Then 
         For  i  As Integer= LBound(Arr,1) To UBound(Arr,1)
             #if TypeOf(T) = TypeOf(Integer)
               sout+=Str(Arr(i)) + " "  
             #ElseIf TypeOf(T) = TypeOf(Double)
               sout+=(Format(Arr(i),sdec)+ " ")
             #EndIf   
         Next i
    Else
        For  i  As Integer= LBound(Arr,1) To UBound(Arr,1)
             #if TypeOf(T) = TypeOf(Integer)
               sout+=  Str(Arr(i)) + Chr(13,10) 
             #elseif TypeOf(T) = TypeOf(Double)
                 sout+= Format(Arr(i),sdec)+ Chr(13,10) 
             #EndIf
        Next i
    End If    
   return sout 
 End Function


 Operator QSVector##T.Cast() As String
 Return this.toString
 End Operator











 Operator + (ByRef v1 As QSVector##T,ByRef v2 As QSVector##T) As QSVector##T
 Dim v As QSVector##T=QSVector##T( iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size)))
 For i As Integer=1 To iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size))
 v[i]=v1[i]+v2[i]
 Next
 Return v
 End Operator

 Operator +( d As T, v As QSVector##T) As QSVector##T
 Dim vv As QSVector##T=QSVector##T(v)
 For i As Integer=1 To v.Size
 vv[i]=v[i]+d
 Next
 Return vv
 End Operator

 Operator -(ByRef v1 As QSVector##T,ByRef v2 As QSVector##T) As QSVector##T
 Dim v As QSVector##T=QSVector##T( iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size)))
 For i As Integer=1 To iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size))
 v[i]=v1[i]-v2[i]
 Next
 Return v
 End Operator

 Operator -( d As T, v As QSVector##T) As QSVector##T
 Return (-d)+v
 End Operator
 
  Operator -(v As QSVector##T, d As T) As QSVector##T
 Return (-d)+v
  End Operator
  
  Operator -( v As QSVector##T) As QSVector##T
 Dim vv As QSVector##T=QSVector##T(v)
 For i As Integer=1 To v.Size
 vv[i]=-v[i]
 Next
 Return vv
  End Operator
  
 Operator * (ByRef v1 As QSVector##T,ByRef v2 As QSVector##T) As QSVector##T
 Dim v As QSVector##T=QSVector##T( iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size)))
 For i As Integer=1 To iif((v1.Size) >(v2.Size), (v1.Size), (v2.Size))
 v[i]=v1[i]*v2[i]
 Next
 Return v
 End Operator

 Operator * ( n As Integer, v As QSVector##T) As QSVector##T
 Dim vv As QSVector##T=QSVector##T(v)
 For i As Integer=1 To v.Size
 vv[i]=v[i]*n
 Next
 Return vv
 End Operator

 Operator * ( v As QSVector##T, n As Integer) As QSVector##T
 Return n*v
 End Operator



 Operator ^ ( v1 As QSVector##T, v2 As QSVector##T) As QSVector##T
 Return v1*v2
 End Operator

 Operator ^ ( v As QSVector##T, d As T) As QSVector##T
 Dim vv As QSVector##T=QSVector##T(v)
 For i As Integer=1 To v.Size
 vv[i]=v[i]^d
 Next
 Return vv
 End Operator

 Operator ^ (d As T, v As QSVector##T) As QSVector##T
 Dim vv As QSVector##T=QSVector##T(v)
 For i As Integer=1 To v.Size
 vv[i]=v[i]^d
 Next
 Return vv
 End Operator
 
 Operator =(v1 As QSVector##T,v2 As QSVector##T) As BOOL
 Dim flag As BOOL
 If v1.Size=v2.Size Then
 For i As Integer=1 To v1.Size
 If v1[i] <> v2[i] Then
 Return FALSE
 Else
 flag=CTRUE
 EndIf
 Next
 EndIf
 Return flag
End Operator

Operator =(v As QSVector##T,value As T) As BOOL
 For i As Integer=1 To v.Size
 If v[i] <> value Then
 Return FALSE
 EndIf
 Next
 Return CTRUE
End Operator

Operator =(value As T,v As QSVector##T) As BOOL
 For i As Integer=1 To v.Size
 If v[i] <> value Then
 Return FALSE
 EndIf
 Next
 Return CTRUE
End Operator

Operator <>(v1 As QSVector##T,v2 As QSVector##T) As BOOL
  Return Not(v1=v2)
End Operator

Operator <>(v As QSVector##T,value As T) As BOOL
  Return Not(v=value)
End Operator

Operator <>(value As T,v As QSVector##T) As BOOL
  Return Not(v=value)
End Operator

Operator <(v As QSVector##T,value As QSVector##T) As BOOL
 For i As Integer=1 To v.Size
   If v[i] > value[i] Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

Operator <(v As QSVector##T,value As T) As BOOL
 For i As Integer=1 To v.Size
   If v[i] > value Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

Operator <(value As T,v As QSVector##T) As BOOL
 For i As Integer=1 To v.Size
   If v[i] > value Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

Operator >(v As QSVector##T,value As QSVector##T) As BOOL
 For i As Integer=1 To v.Size
   If v[i] > value[i] Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

Operator >(v As QSVector##T,value As T) As BOOL
  For i As Integer=1 To v.Size
   If v[i] < value Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

Operator >(value As T,v As QSVector##T) As BOOL
  For i As Integer=1 To v.Size
   If v[i] < value Then
     Return FALSE
    EndIf
 Next
 Return CTRUE
End Operator

 Function ArrayToVector OverLoad (a() As T) As QSVector##T
 Dim v As QSVector##T=QSVector##T(UBound(a))
 For i As Integer=1 To UBound(a)
 v[i]=a(i)
 Next
 Return v
 End Function

 Function SORT OverLoad(a As QSVector##T,ASCEND_direction As BOOL=CTRUE ) As QSVector##T

 Dim As integer i
 Dim As integer j
 Dim As T s

 Dim res As QSVector##T=a

 If ASCEND_direction Then ASCEND_direction=1
 Select Case ASCEND_direction
 Case 1

 For i =1 To res.Size
 For j =i+1 To res.Size
 if (res[j]<res[i]) Then
 s=res[i]
 res[i]=res[j]
 res[j]=s

 end if

 Next j

 Next i
 Case 0
 For i =1 To res.Size
 For j =i+1 To res.Size
 if ( res[j] >res[i]) Then
 s=res[i]
 res[i]=res[j]
 res[j]=s
 end if
 Next j
 Next i
 End Select
 Return res
 End Function
 

[aloberoger]

QSmatrix.bas

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"



#Include Once "QSVectors.bas"


 #Define QSMatrix(T) QSMatrix##T

#Macro QSMATRIX_TEMPLATE(T)
  
 
 
Type QSMatrix##T
 	Public:
 	   Declare Constructor()
	   Declare Constructor (Highbound1 As Integer,Highbound2 As Integer,defvalue As T=0)
	   Declare Destructor
      Declare Property Rows(value As Integer) ' set the number of rows
	   Declare Property Rows() As Integer       ' returns the number of rows
      Declare Property Cols(value As Integer)  ' set the number of columns
      Declare Property Cols()  As Integer  ' returns the number of columns
      Declare Operator [](irow As integer)ByRef As QSVector##T
	   Declare Function at(irow As Integer,icol As Integer) ByRef As T 
	   Declare Sub Copy(a() As T)     ' copie A() dans DenseMatrix 
	   Declare Sub CopyTo(a() As T)   ' copie DenseMatrix dans A()
      Declare Operator Let(ByRef m As  QSMatrix##T)
	   Declare Operator Let(byval value As T)
	   Declare Function transpose() As QSMatrix##T  ' Calculate a transpose of this matrix 
      Declare Function get_diag()  As QSVector##T  ' Obtain a vector of the diagonal elements 
     Declare Operator Cast() As String
 
 	Private:
 	  Dim Arr(any) As QSVector##T
 	  m_lowbound(1 To 2) As Integer
     m_Highbound(1 To 2)As Integer
 End Type

Constructor  QSMatrix##T()
  '   ReDim  Arr(0 To -1)
End Constructor

Destructor QSMatrix##T()
  Erase Arr
End Destructor

  Constructor  QSMatrix##T (Highbound1 As Integer,Highbound2 As Integer,defvalue As T=0)
      ReDim Arr(1 To Highbound1)
      For i As Integer=1 To Highbound1
          Arr(i)=QSVector##T(Highbound2)
      Next i
       m_lowbound(1)=1 :m_lowbound(2)=1
       m_Highbound(1)=Highbound1: m_Highbound(2)=Highbound2
       
      For i As Integer=1 To Highbound1
      	For j As Integer=1 To Highbound2
          Arr(i)[j]=defvalue
      	Next j  
      Next i 
       
  End Constructor
  
  Property QSMatrix##T.Rows(value As Integer) ' set the number of rows
      m_Highbound(1)=value  ': m_Highbound(2)=this.Cols sinon 
      ReDim Arr(1 To  m_Highbound(1))
      For i As Integer=1 To m_Highbound(1)
          Arr(i)=QSVector##T(m_Highbound(2))
      Next i
  End Property
 
  Property QSMatrix##T.Rows() As Integer ' returns the number of rows
    return UBound(Arr,1)-LBound(Arr,1) +1 
  End Property
 
  Property QSMatrix##T.Cols(value As Integer)   ' set the number of columns
   m_Highbound(2)=value     ':m_Highbound(1)=this.Rows: sinon erreur  
   ReDim Arr(1 To  m_Highbound(1))
      For i As Integer=1 To m_Highbound(1)
          Arr(i)=QSVector##T(m_Highbound(2))
      Next i  
  End Property
  
  Property QSMatrix##T.Cols()  As Integer  ' returns the number of columns
    return m_Highbound(2)-LBound(Arr,1)  +1 
  End Property

   Operator QSMatrix##T.[](irow As integer)ByRef As QSVector##T
   	  Return Arr(irow)
   End Operator
   
   Function QSMatrix##T.at(irow As Integer,icol As Integer) ByRef As T
 	 If irow<1 Or irow>m_Highbound(1) _
    	Or icol<1 Or icol>m_Highbound(2) Then  
    	Messagebox NULL , "Les indices sont en dehors de la plage (" & irow & ";" & icol & ")" ,"erreur dans QSMatrix.at",MB_ICONERROR
    	Return Arr(1)[1]
    EndIf
     Return Arr(irow)[icol]
   End Function
   
   Sub QSMatrix##T.Copy(A() As T)
   this.constructor( UBound(A,1), UBound(A,2))
   For  i  As Integer= 1 To UBound(A,1)
      for j As Integer= 1 To UBound(A,2)
        Arr(i)[j]=A(i,j)  
      Next j
   Next i
 End Sub
 
 
  Sub QSMatrix##T.CopyTo(a() As T)
   	If this.rows=0 Or This.cols=0 Then Return
   	ReDim a(1  To UBound(Arr,1),1  To m_Highbound(2))
   	 for  i  As Integer= 1  To UBound(Arr,1)
            for   j  As Integer= 1  To m_Highbound(2)
               a(i,j)=Arr(i)[j] 
            Next j
   	 Next i
  End Sub
   
   
   Operator  QSMatrix##T.Let(ByRef  m As QSMatrix##T)
 	if(@this <> @m) Then 'assignation M = M impossible
 	This.constructor( m.m_Highbound(1), m.m_Highbound(2))
 	For i As Integer= 1   To UBound(Arr,1) 
 		 For j As Integer= 1  To  m.m_Highbound(2)
 		 	Arr(i)[j]=m.at(i,j)
 		 Next
 	Next
 	End If
 End Operator
 
 Operator  QSMatrix##T.Let(byval value As T)
 	 For i As Integer= 1   To UBound(Arr,1) 
 		 For j As Integer= 1  To this.m_Highbound(2)
 		 	Arr(i)[j]=value
 		 Next
 	Next
 End Operator
 
' Calculate a transpose of this matrix                                                                                                                                       

Function QSMatrix##T.transpose() As QSMatrix##T
  Dim As QSMatrix##T result=QSMatrix##T(this.rows, this.cols) 

  for  i As Integer=1 To this.rows
    for  j  As Integer=1 To this.cols
      result.at(i,j) = this.Arr(j)[i]
    Next j
 Next i
  return result 
End Function


' Obtain a vector of the diagonal elements                                                                                                                                   

Function QSMatrix##T.get_diag()  As  QSVector##T
  Dim As QSVector##T result=QSVector##T(this.rows) 
  for  i As Integer=1 To this.rows 
    result[i] = this.Arr(i)[i]
  Next
  return result 
End Function
 
 
 
 Operator QSMatrix##T.cast() As String 
   Dim as String sOut
    For  i  As Integer= 1  To UBound(Arr,1)
      For   j  As Integer= 1  To  Arr(i).Size
         Dim as T value = Arr(i)[j] 
         sout +=" " 
         #if TypeOf(T) = TypeOf(Integer)
             sout+= "    " +   Str(value) 
         #endif
         #if TypeOf(T) = TypeOf(Double)
             sout+=("    " +  Format(value,"####0.0000"))
         #EndIf 
         #if TypeOf(T) = TypeOf(Single)
             sout+=("    " +  Format(value,"####0.0000"))
         #EndIf 
        
      Next j
      sOut += (!"\n") 
    Next i
    
     #if TypeOf(T) = TypeOf(QSVector##T)
        For  i  As Integer= 1  To UBound(Arr,1)
        For   j  As Integer= 1  To  Arr(i).Size
         Dim as T value = Arr(i)[j] 
         
         sout=Cast(String,value)
        
      Next j
      sOut += (!"\n") 
    Next i
    Print "Need to be implemented"
     #EndIf 
   Return sout 
 End Operator
 

 
 ' write differents operators heare
  
 
 Function Eye OverLoad (ByVal n As Integer) As QSMatrix##T ' Creates a new Identity Matrix.
			Dim As QSMatrix##T buf = QSMatrix##T(n, n)
			for i As Integer = 1 To  n
			  For j As Integer  = 1 To n
				  If i=j Then buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
End Function

    Function Eye OverLoad (ByVal n As Integer,ByVal m As Integer) As QSMatrix##T ' Creates a new Identity Matrix.
			Dim As QSMatrix##T buf = QSMatrix##T(n, m)
			for i As Integer = 1 To  n
			  For j As Integer  = 1 To m
				  If i=j Then buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
    End Function
    
		Function Zeros OverLoad (ByVal m As Integer, ByVal n As Integer) As QSMatrix##T ' Creates row by n QSMatrix filled with zeros.
			Return  QSMatrix##T(m, n)
		End Function

		Public   Function Zeros(ByVal n As Integer) As QSMatrix##T  ' Creates n by n QSMatrix filled with zeros.
			Return  QSMatrix##T(n,n)
		End Function


		  Function Ones OverLoad (ByVal m As Integer, ByVal n As Integer) As QSMatrix##T ' Creates m by n QSMatrix filled with ones.
			Dim As QSMatrix##T buf = QSMatrix##T( m,n)
			for i As Integer = 1 To  m
			  For j As Integer  = 1 To n
				  buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
		End Function

      
		 Function Ones OverLoad(ByVal n As Integer) As QSMatrix##T ' Creates n by n QSMatrix filled with ones.
			Dim As QSMatrix##T buf = QSMatrix##T(n,n)
			for i As Integer = 1 To n
			  For j As Integer  = 1 To n
				  buf.at(i,j) = 1.0
			  Next j
			Next i  
			Return buf
		End Function
 
  Function Transpose OverLoad(m As QSMatrix##T)As QSMatrix##T
  	  Dim result As QSMatrix##T=QSMatrix##T(m.cols,m.rows)
  	  For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
  	  	        result[i][j]=m[j][i]
 		 Next j
	  Next i 
  	  
  	  Return result
  End Function
 
Operator + (m1 As QSMatrix##T,m2 As QSMatrix##T) As QSMatrix##T
	Dim As QSMatrix##T m=QSMatrix##T(m1)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)=m1.at(i,j)+ m2.at(i,j) 
 		 Next
	Next 
	Return m
End Operator

Operator + (m1 As QSMatrix##T,d As T) As QSMatrix##T
	Dim As QSMatrix##T m=QSMatrix##T(m1)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)=m1.at(i,j)+d 
 		 Next
	Next 
	Return m
End Operator

Operator + (d As T ,m1 As QSMatrix##T) As QSMatrix##T
	Return (m1+d)
End Operator

Operator - (m1 As QSMatrix##T,m2 As QSMatrix##T) As QSMatrix##T      ' subtraction of QSMatrix with QSMatrix
	Dim As QSMatrix##T m=QSMatrix##T(m1)
	' check if the dimensions match
   If (m1.rows = m2.rows And m1.cols = m2.cols) then
   	
	  For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m[i][j]=m1[i][j]-m2[i][j]
 		  Next
	   Next 
	   
   End If   
	  Return m
End Operator
 
 
 Operator - (m As QSMatrix##T) As QSMatrix##T      ' minus of QSMatrix with QSMatrix
  Dim As QSMatrix##T m2=QSMatrix##T(m)
	For i As Integer= 1 To m2.Rows 
 		 For j As Integer= 1 To m2.Cols
 		 	 m2[i][j]= -m[i][j]
 		 Next
	Next 
	Return m2
 End Operator

  
Operator - (d As T , m2 As QSMatrix##T) As QSMatrix##T
	Dim As QSMatrix##T m=QSMatrix##T(m2)
	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	 m.at(i,j)= d-m2.at(i,j) 
 		 Next
	Next 
	Return m
End Operator


Operator - (m2 As QSMatrix##T , d As T) As QSMatrix##T
	Return (-d+m2)
End Operator
 
  
 Private Function matmul OverLoad (m1 As QSMatrix##T,m2 As QSMatrix##T) As QSMatrix##T
 If (M1.cols <> M2.rows)Then
 	Messagebox Getactivewindow(),"Revoir les bornes des QSMatrix m1 et m2","Matmul impossible",MB_ICONERROR
 	Return QSMatrix##T()
 EndIf
 Dim m3 As QSMatrix##T=QSMatrix##T( m1.Rows, m2.Cols)
 Dim As T DSUM
 For  I As Integer=1 to m1.Rows
  For J  As Integer=1 to m2.Cols
   DSUM=0.00
   For K  As Integer=1 to m1.Cols 
     DSUM=DSUM+m1.at(I,K)*m2.at(K,J)
   Next K
    m3.at(I,J)=DSUM 
  Next j
 Next i
Return m3
End Function

 Operator * (A As QSMatrix##T,B As QSMatrix##T) As QSMatrix##T
	Return matmul(A,B)
End Operator

 
Operator * (m1 As QSMatrix##T,v As QSVector##T) As QSVector##T    'Y(M)=A(M,N)*X(N)
 If (m1.cols<> v.size)  Then
	Messagebox Getactivewindow(),"Revoir les bornes de la QSMatrix m1 et du vecteur","Multiplication matrice-vecteur impossible",MB_ICONERROR
	Return QSVector##T()
EndIf
 Dim Y As QSVector##T=QSVector##T(m1.Rows)
  Dim As T  dSum=0.0D+00
  For i As Integer =1 To m1.Rows
    dSum = 0.0D+00
    For j As Integer = 1 To m1.cols
      dSum = dSum + m1.at(i,j) * v[j]
      Y[i]=dSum
    Next j
  Next i
	Return Y
End Operator

 
Operator * (v As QSVector##T,m2 As QSMatrix##T) As QSVector##T
	Return m2*v
End Operator

Operator * (n As Integer,m As QSMatrix##T) As QSMatrix##T
	Dim As QSMatrix##T nm=QSMatrix##T(m)
	For i As Integer= 1 To m.rows 
 		 For j As Integer= 1 To m.cols
 		 	nm.at(i,j)=n*m.at(i,j) 
 		 Next
	Next  
	Return nm
End Operator

Operator * (m As QSMatrix##T,n As Integer) As QSMatrix##T
	Return (n*m)
End Operator
 
 
Operator ^ (m As QSMatrix##T, n As Integer) As QSMatrix##T
 '	If n=-1 Then Return  m.inverse()
 	If n=0 Then  Return  Eye(m.rows,m.cols)
 	If n<0 Then 
 		Messagebox (Getactivewindow(),"n<0 Pas encore pris en charge","Error",MB_ICONERROR)
 		Return QSMatrix##T()
 	EndIf
 	Dim As QSMatrix##T mm=QSMatrix##T(m)
 	For i As Integer=1 To n 
 	   mm = mm*mm
   Next i
	Return mm
 End Operator

 
Operator \(m1 As QSMatrix##T,Y As QSVector##T) As QSVector##T    'résolution de gauss A(M,N)*X(N)=Y(M)
 Dim X As QSVector##T=Y
 ' m1.LINEQ(X)
	Return X
End Operator



Operator =(m1 As QSMatrix##T,m2 As QSMatrix##T) As BOOL
	 Dim flag As BOOL
	    
	   If   m1.Rows=m2.Rows And _
	    	   m1.cols =m2.cols Then
	       	For i As Integer= 1 To m1.Rows 
 		         For j As Integer= 1  To m1.cols 
 		 	         If m1.at(i,j) <> m2.at(i,j) Then
 		 	         	Return FALSE
 		 	         Else
 		 	           flag=CTRUE
 		 	         EndIf
 		 	         
 		         Next
  	         Next  
	 EndIf
	 Return flag      
End Operator


Operator =(m As QSMatrix##T,value As T) As BOOL
  	For i As Integer= 1 To m.Rows 
 		 For j As Integer= 1 To m.Cols
 		 	   If m.at(i,j) <> value Then
 		 	      Return FALSE
 		 	   EndIf
 		   Next
  	Next  
 Return CTRUE   
End Operator

 Function   GaussJordan (ByRef ainv As QSMatrix##T)As T
' ------------------------------------------------------------------
' Gauss-Jordan algorithm for a Matrix Arr(L..N, L..M) with M >= N
' ------------------------------------------------------------------
' On input: 
'   * The submatrix Arr(L..N, L..N) contains the system DenseMatrix
'   * The submatrix Arr(L..N, (N+1)..M) contains the constant vector(s)
'
' On output:
'   * The submatrix Arr(L..N, L..N) contains the inverse DenseMatrix
'   * The submatrix Arr(L..N, (N+1)..M) contains the solution vector(s)
'   * The determinant of the system DenseMatrix is returned in Det
'   * The error code is returned in the global variable ErrCode:
'       ErrCode = MatOk     ==> no error
'       ErrCode = MatErrDim ==> non-compatible dimensions (N < M)
'       ErrCode = MatSing   ==> quasi-singular DenseMatrix
' ------------------------------------------------------------------

  'ReDim A(1  To UBound(Arr,1),1  To UBound(Arr,2)) 
   Dim A()As T
   ainv.CopyTo(A())
   
  Dim ddet As T
  Dim L As Integer, n As Integer, m As Integer   ' Bounds of Arr
  Dim i As Integer, j As Integer, k As Integer   ' Loop variables
  Dim Ik As Integer, Jk As Integer    ' Pivot coordinates
  Dim Pvt As T        ' Pivot
  Dim taux As T          ' Auxiliary variable

  L = LBound(A, 1)
  n = UBound(A, 1)
  m = UBound(A, 2)
  
  If n > m Then
    Print " N > M revoir les données", "Erreur"
    Return 0
  End If

  ReDim PRow(L To n) As Integer   ' Stores line of pivot
  ReDim PCol(L To n) As Integer   ' Stores column of pivot
  ReDim MCol(L To n) As T    ' Stores a column of the DenseMatrix

  ddet = 1
  k = L

  Do While k <= n
    ' Search for largest pivot in submatrix Arr[K..N, K..N]
    Pvt = A(k, k)
    Ik = k
    Jk = k
    For i = k To n
      For j = k To n
        If Abs(A(i, j)) > Abs(Pvt) Then
          Pvt = A(i, j)
          Ik = i
          Jk = j
        End If
      Next j
    Next i

    ' Pivot too small ==> quasi-singular DenseMatrix
    If Abs(Pvt) < 0.000001 Then
      ddet = 0
      Messagebox Getactivewindow(), "La Matrice est singuliere ",  "ERREUR in GaussJordan",MB_ICONERROR
      Return 0
    End If

    ' Save pivot position
    PRow(k) = Ik
    PCol(k) = Jk

    ' Update determinant
    ddet = ddet * Pvt
    If Ik <> k Then ddet = -ddet
    If Jk <> k Then ddet = -ddet

    ' Exchange current row (K) with pivot row (Ik)
    If Ik <> k Then
      For j = L To m
        SWAP A(k, j), A(Ik, j)
      Next j
    End If

    ' Exchange current column (K) with pivot column (Jk)
    If Jk <> k Then
      For i = L To n
        SWAP A(i, k), A(i, Jk)
      Next i
    End If

    ' Store col. K of Arr into MCol and set this col. to 0
    For i = L To n
      If i <> k Then
        MCol(i) = A(i, k)
        A(i, k) = 0
      Else
        MCol(i) = 0
        A(i, k) = 1
      End If
    Next i

    ' Transform pivot row
    For j = L To m
      A(k, j) = A(k, j) / Pvt
    Next j

    ' Transform other rows
    For i = L To n
      If i <> k Then
        taux = MCol(i)
        For j = L To m
          A(i, j) = A(i, j) - taux * A(k, j)
        Next j
      End If
    Next i

    k = k + 1
  Loop

  ' Exchange lines of whole DenseMatrix
  For i = n To L Step -1
    Ik = PCol(i)
    If Ik <> i Then
      For j = L To m
        SWAP A(i, j), A(Ik, j)
      Next j
    End If
  Next i

  ' Exchange columns of inverse DenseMatrix
  For j = n To L Step -1
    Jk = PRow(j)
    If Jk <> j Then
      For i = L To n
        SWAP A(i, j), A(i, Jk)
      Next i
    End If
  Next j
  
  ainv.copy(A()) 
  
  Return ddet  
End Function
 
 
Function extracts OverLoad (A As QSMatrix##T,i1 As Integer ,i2 As Integer,j1 As Integer,j2 As Integer) As QSMatrix##T
  	If i2 >= i1 And j2 >= j1 Then
  		Dim m As QSMatrix##T=QSMatrix##T(i2-i1+1,J2-j1+1) 
  		For i As Integer=i1 To i2
  			For j As Integer=j1 To j2
  				m.at(i-i1+1,J-j1+1)=A.at(i,j)
  			Next j
  		Next i
  		Return m
  	EndIf
  	Return QSMatrix##T()
  End Function
 
 Function extractCol OverLoad (m As QSMatrix##T,icol As Integer) As QSvector##T
 	If icol>=1  Or icol<=m.Cols Then
 		Dim v As QSvector##T=QSvector##T(m.Rows)
 		For i As Integer=1  To v.size 
 			v[i]=m.at(i,icol)
 		Next
 		Return v
 	EndIf
 	 Return QSvector##T()
 End Function
 
 Function ExtractRow OverLoad (m As QSMatrix##T,irow As Integer) As QSvector##T
 	If irow>=1  Or irow<=m.Rows Then
 		Dim v As QSvector##T=QSvector##T(m.Cols)
 		For j As Integer=1  To v.size
 			v[j]=m.at(irow,j)
 		Next j
 		Return v
 	EndIf
 	 Return QSvector##T()
 End Function
 
 Function inverse  OverLoad (m As QSMatrix##T) As QSMatrix##T
 	if (m.rows <> m.cols)then
      Messagebox(NULL,"Matrix must be square","Error INVERSE Function",MB_ICONERROR) 
      return  QSMatrix##T()
   else
 	   Dim As  QSMatrix##T res=m
 	   Dim As T Det=GaussJordan(res) 
      If Det=0 Then Messagebox(NULL,"Determinant of DenseMatrix is zero","Error in INVERSE Function",MB_ICONERROR) 
      return res
    End If
 
  return QSMatrix##T()
 End Function
 
 Function  Determinant OverLoad (m As QSMatrix##T) As T         ' la matrice n'est pas inversée
 	Dim b As QSMatrix##T=m
 	Return GaussJordan(b) 
 End Function

 #EndMacro

[aloberoger]

testqsvector.bas

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"
 

 #Include Once "QSVectors.bas" 

 
 QSVECTOR_TEMPLATE(Double)
  QSVECTOR_TEMPLATE(QSVector(Double))
  
  
  ' below some demonstration of the usage of the QSMatrix(double) class
 
     
    Dim As Integer cols = 3 
    Dim As Integer rows = 3 
    Dim As  QSVector(Double)  A =  QSVector(Double)(rows) 

    ' fill in some values in QSMatrix(double) a
    Dim As Integer count = 0
    for  r As Integer= 1 To rows 
        A[r]=r +300
    Next r

        
    print A 
    Print 

    ' construction d'un vecteur de (rows=3) elements contenant des tableaux de QSVector(Double) initialisé tous à A
     Dim As  QSVector(QSVector(Double))  B =  QSVector(QSVector(Double))(rows,A) 
    
    
     
    print "B =  " 
     Print B[1]
     Print B[2]
     Print B[3]
     
     B[1][2]=689
     
     Print B[1][1]
     Print B[1][2]
     Print B[1][3]
    Print

    
  
  
  Sleep
  

[aloberoger]

testmatmul.bas

Code: Select all

 
 #Include Once "windows.bi"
#Include Once "vbcompat.bi"
#Include Once "QMatrix.bas" 

QSVECTOR_TEMPLATE(Double)    
QSMATRIX_TEMPLATE(Double)



#Include Once "crt.bi"


Print " MATRICES SANS CONSTRUCTORS"
  Dim M1 As QSMatrix(Double) '=Matrix(1,3)
 M1.Rows=1 :M1.cols=3
 M1.at(1,1)=1.00  : M1.at(1,2)=2.00   :  M1.at(1,3)=3.00
  

 
  Dim M2 As QSMatrix(Double) '=Matrix(3,1)
 M2.Rows=3 :M2.cols=1
 M2.at(1,1)=0.00   
 M2.at(2,1)= -1.00  
 M2.at(3,1)=2.00   
 
 Dim M  As QSMatrix(Double)
 
 Print "M1:"
 Print M1 
 Print
 Print "M2:"
Print M2 
Print

Print
  Print "M1*M2:  possible si M1.cols = M2.rows"
  M= M1*M2       
  Print M
  Print "M.rows= " & M.rows
  Print "M.Cols= " & M.Cols
 Print
  Print "M2*M1:"
  M= M2*M1
  Print M
  Print "M.rows= " & M.rows
  Print "M.Cols= " & M.Cols
  Print
  
Dim A As QSMatrix(Double) 
 A.Rows=2 : A.Cols=3
 A.at(1,1)=0.00 : a.at(1,2)=0.00 :  A.at(1,3)=0.00 
 A.at(2,1)=1.00 : A.at(2,2)=2.00:  A.at(2,3)=3.00  
  
 Dim B As QSMatrix(Double) '=Matrix(3,3)
 B.rows=3 :B.cols=3
 B.at(1,1)=-1.00  : B.at(1,2)=1.00   :  B.at(1,3)=0.00
 B.at(2,1)= -1.00 : B.at(2,2)=1.00  :  B.at(2,3)=-3.00
 B.at(3,1)=1.00   : B.at(3,2)=-1.00   :  B.at(3,3)=2.00 

Print "A:"
 Print A 
 Print
 Print "B:"
Print B 
Print

Print "A*B can be null with A and B not null"
  Print "A*B:"
  Print A*B          ' possible si A.cols = B.rows

   
  Print
 
  Sleep
 

[aloberoger]

note that i am having some difficulties to run matrix of vector because of gaussjordan(something to do)

testvectorofvector.bas

Code: Select all

#Include Once "windows.bi"
#Include Once "vbcompat.bi"
 

 #Include Once "QMatrix.bas" 

 QSVECTOR_TEMPLATE(Double) 
 QSVECTOR_TEMPLATE(QSVector(Double))    
 QSMATRIX_TEMPLATE(QSVector(Double))
 
 
  ' below some demonstration of the usage of the QSMatrix(double) class
 
    ' create an empty QSMatrix(QSVector(Double)) of 3x3 (will initially contain zeros)
    Dim As Integer cols = 3 
    Dim As Integer rows = 3 
    
    Dim v1 As QSVector(Double)=QSVector(Double)(4,500)
     Print
    Print " a vector of double V2"
    Print v1
    Print
    
    
    Dim As QSMatrix(QSVector(Double)) A = QSMatrix(QSVector(Double))(rows,cols, v1) 
    
    
    Print
    Print " Get some value of matrix A:"
    Print " First Vector of A:"
    Print A[1][1]
    Print
    

    Dim v2 As QSVector(Double)=QSVector(Double)(rows,200)
    Print
    Print " a vector of double V2"
    Print v2
    Print
    
    ' fill in some values in QSMatrix(QSVector(Double)) B
    Dim As QSMatrix(QSVector(Double)) B = QSMatrix(QSVector(Double))(rows+10,cols, 0)
    Print " Put some new values to matrix B:"
    Dim As Integer count = 0
    for  r As Integer= 1 To rows 
      for  c As integer= 1 to cols 
        B[r][c].size=3 
        B[r][c][1]=12
        B[r][c][2]=13
        B[r][c][3]=14
      Next c
   Next r

     

     
    Print "print the first vector of B" 
    print B[1][1]
    Print 

    ' print the whole QSMatrix(QSVector(Double))   not supported yet
    Print "print the whole QSMatrix(QSVector(Double))   not supported yet"
    print "B =  " 
     Print B
    Print

    
  
  
  Sleep