在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中使用稀疏矩陣

回答

相關問題