在VB中使用稀疏矩阵

我正在使用Visual Basic中的最小二乘法程序，该程序要求我处理44000个点才能找到一个超定的解决方案。我正在使用一个线性代数矩阵，它接受二维数组作为双矩阵。它允许我进行反转，转置和执行基本矩阵计算。问题是当我输入3000点以上时，程序不断崩溃。我认为这与我的A（设计）矩阵中有零的事实有关。我知道使用稀疏矩阵将通过删除包含零的列和行来帮助我，但我不知道如何在我的程序中实现此操作。任何人都可以帮助我弄清楚如何使用当前使用的线性代数库的稀疏矩阵，或者我可以让我的程序在没有崩溃的情况下处理44000个点的代码？我在时间限制和帮助将不胜感激。谢谢 S.P在VB中使用稀疏矩阵

来源

2011-10-06 Sumayyah Patel

在你自己的稀疏矩阵类（from here: Sparse Matrix Class Demo）中尝试类似的东西。

Private m_RowCollection As New Collection 

'Returns the cell value for the given row and column 
Public Property Get Cell(nRow As Integer, nCol As Integer) 
    Dim ColCollection As Collection 
    Dim value As Variant 

    On Error Resume Next 
    Set ColCollection = m_RowCollection(CStr(nRow)) 
    'Return empty value if row doesn't exist 
    If Err Then Exit Property 
    value = ColCollection(CStr(nCol)) 
    'Return empty value is column doesn't exist 
    If Err Then Exit Property 
    'Else return cell value 
    Cell = value 
End Property 

'Sets the cell value for the given row and column 
Public Property Let Cell(nRow As Integer, nCol As Integer, value As Variant) 
    Dim ColCollection As Collection 

    On Error Resume Next 
    Set ColCollection = m_RowCollection(CStr(nRow)) 
    'Add row if it doesn't exist 
    If Err Then 
     Set ColCollection = New Collection 
     m_RowCollection.Add ColCollection, CStr(nRow) 
    End If 
    'Remove cell if it already exists (errors ignored) 
    ColCollection.Remove CStr(nCol) 
    'Add new value 
    ColCollection.Add value, CStr(nCol) 
End Property

来源

2011-10-06 19:42:58

这是一个快速的&脏稀疏矩阵类与数组实现。 Const CHUNK_SIZE控制着martix的“稀疏性”。阵列重新分配发生在2个边界的权力上。只支持积极的索引。

Option Explicit 
DefObj A-Z 

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal nBytes As Long) 

Private Const CHUNK_SIZE    As Long = 100 

Private Type UcsColChunk 
    ColValue()      As Double 
End Type 

Private Type UcsRowValue 
    ColChunk()      As UcsColChunk 
End Type 

Private Type UcsRowChunk 
    RowValue()      As UcsRowValue 
End Type 

Private m_uRowChunks() As UcsRowChunk 

Property Get Cell(ByVal lRow As Long, ByVal lCol As Long) As Double 
    On Error Resume Next 
    Cell = m_uRowChunks(lRow \ CHUNK_SIZE).RowValue(lRow Mod CHUNK_SIZE).ColChunk(lCol \ CHUNK_SIZE).ColValue(lCol Mod CHUNK_SIZE) 
End Property 

Property Let Cell(ByVal lRow As Long, ByVal lCol As Long, ByVal dblValue As Double) 
    If pvPeek(ArrPtr(m_uRowChunks)) = 0 Then 
     ReDim m_uRowChunks(0 To pvCalcSize(lRow \ CHUNK_SIZE)) As UcsRowChunk 
    ElseIf UBound(m_uRowChunks) < lRow \ CHUNK_SIZE Then 
     ReDim Preserve m_uRowChunks(0 To pvCalcSize(lRow \ CHUNK_SIZE)) As UcsRowChunk 
    End If 
    With m_uRowChunks(lRow \ CHUNK_SIZE) 
     If pvPeek(ArrPtr(.RowValue)) = 0 Then 
      ReDim .RowValue(0 To CHUNK_SIZE - 1) As UcsRowValue 
     End If 
     With .RowValue(lRow Mod CHUNK_SIZE) 
      If pvPeek(ArrPtr(.ColChunk)) = 0 Then 
       ReDim .ColChunk(0 To pvCalcSize(lCol \ CHUNK_SIZE)) As UcsColChunk 
      ElseIf UBound(.ColChunk) < lCol \ CHUNK_SIZE Then 
       ReDim Preserve .ColChunk(0 To pvCalcSize(lCol \ CHUNK_SIZE)) As UcsColChunk 
      End If 
      With .ColChunk(lCol \ CHUNK_SIZE) 
       If pvPeek(ArrPtr(.ColValue)) = 0 Then 
        ReDim .ColValue(0 To CHUNK_SIZE - 1) As Double 
       End If 
       .ColValue(lCol Mod CHUNK_SIZE) = dblValue 
      End With 
     End With 
    End With 
End Property 

Private Function pvCalcSize(ByVal lSize As Long) As Long 
    pvCalcSize = 2^(Int(Log(lSize + 1)/Log(2)) + 1) - 1 
End Function 

Private Function pvPeek(ByVal lPtr As Long) As Long 
    Call CopyMemory(pvPeek, ByVal lPtr, 4) 
End Function

来源

2011-10-07 08:32:04 wqw

在VB中使用稀疏矩阵

回答

相关问题