Использование разреженных матриц в VB

Question

Я работаю над программой наименьших квадратов в Visual Basic, которая требует от меня обработки 44000 точек, чтобы найти переопределенное решение.Я использую матрицу линейной алгебры, которая принимает двумерные массивы как двойные матрицы. Это позволяет мне инвертировать, транспонировать и выполнять базовые матричные вычисления.проблема заключается в том, что программа продолжает сбой, когда я ввожу более 3000 баллов.Я думаю, что это связано с тем, что у меня есть нули в моей (дизайн) матрице.Я знаю, что использование разреженной матрицы поможет мне, удалив столбцы и строки, содержащие нули, но я понятия не имею, как мне следует реализовать это в моей программе.Кто-нибудь может мне помочь понять, как использовать разреженные матрицы с текущей библиотекой линейной алгебры, которую я использую, или какой код я могу позволить моей программе обрабатывать 44000 точек без сбоев?Я ограничен во времени, и помощь будет высоко ценится.Спасибо SP

Answer 1

Вот класс быстрой и грязной разреженной матрицы, реализованный с помощью массивов.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

Answer 2

Попробуйте что-то подобное в своем собственном классе разреженных матриц ( отсюда: демонстрация класса разреженных матриц ).

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