Fatal编程技术网
  • vb6/
  • Vb6 在VB中使用稀疏矩阵

Vb6 在VB中使用稀疏矩阵

vb6

Vb6 在VB中使用稀疏矩阵,vb6,Vb6,我正在用VisualBasic编写一个最小二乘法程序，该程序要求我处理44000个点，以找到一个超定解。我使用一个线性代数矩阵，它接受二维数组作为双矩阵。它允许我反转、转置和执行基本矩阵计算。问题是，当我输入超过3000点时，程序不断崩溃。我认为这与我的A（设计）矩阵中的零有关。我知道使用稀疏矩阵将通过删除包含零的列和行来帮助我，但我不知道应该如何在程序中实现这一点。有谁能帮我弄清楚如何在我正在使用的线性代数库中使用稀疏矩阵，或者我可以用什么代码让我的程序在不崩溃的情况下处理44000个点？我有

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

在您自己的稀疏矩阵类（）中尝试类似的操作

下面是一个用数组实现的快速而脏的稀疏矩阵类。Const
CHUNK\u 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

选项显式
DefObj A-Z
私有声明函数ArrPtr Lib“msvbvm60”别名“VarPtr”（Ptr（）如有），长度为
私有声明子CopyMemory Lib“kernel32”别名“rtlmovemory”（dst为任意，src为任意，ByVal n字节为任意长度）
私有常量块大小（长=100）
私有类型UcsColChunk
ColValue（）为双精度
端型
私有类型UcsRowValue
ColChunk（）作为UcsColChunk
端型
私有类型UcsRowChunk
RowValue（）作为UcsRowValue
端型
私有m_uRowChunks（）作为UcsRowChunk
属性将单元格（ByVal lRow为Long，ByVal lCol为Long）获取为Double
出错时继续下一步
Cell=m\u uRowChunks（lRow\CHUNK\u SIZE）.RowValue（lRow Mod CHUNK\u SIZE）.ColChunk（lCol\CHUNK\u SIZE）.ColValue（lCol Mod CHUNK\u SIZE）
端属性
属性Let单元格（ByVal lRow为Long，ByVal lCol为Long，ByVal dblValue为Double）
如果pvPeek（ArrPtr（m_uRowChunks））=0，则
将m_uRowChunks（0到pvCalcSize（lRow\CHUNK_SIZE））重新定义为UcsRowChunk
ElseIf UBound（mu uRowChunks）
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