Question

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

Answer 1

在您自己的稀疏矩阵类（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

Answer 2

这是一个用数组实现的快速和脏的稀疏矩阵类。 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

在VB中使用稀疏矩阵

2 个答案: