Рисование большого количества линий.net

Question

Некоторое время я искал, как можно улучшить производительность рендеринга моей диаграммы формы сигнала. В настоящее время я использую (насколько я считаю возможным) оптимизированную процедуру рендеринга на основе GDI:

Private Sub Calculate2(ByVal aData()() As Double)
    'aData size: 1000 traces with 200k points each -> Dim aData(1000, 200000)

    'Some data preparations doing roughly the same as they would in the real app
    Dim PS_Y As Double = 1
    Dim Origin As PointF = New PointF(Rnd() * 100, Rnd() * 100)
    PS_Y = Rnd() + 0.1
    Dim Data(), ST As Double
    Dim lPoints As New List(Of PointF)
    Dim PS_X As Double = Rnd() + 0.1

    'Graphics initialisation
    Dim Img As New Bitmap(900, 600)
    Dim ImgGR As Graphics = Graphics.FromImage(Img)
    ImgGR.Clear(Color.White)
    Dim WFPen As New Pen(Brushes.Black, 1)

    'Cache property values for faster access:
    Dim l As Integer = 100 'ChartRect.Left
    Dim r As Integer = 1000 'ChartRect.Right

    'Process trace by trace:
    For i = 0 To aData.Length - 1
        ST = Rnd() 'x distance of the points
        Data = aData(i) 'y values, 1 per x value

        If Data.Length = 0 Then Continue For

        'scale precalculations, first & last displayed points:
        Dim ScaleX As Double = ST * PS_X
        Dim OrigX As Single = Origin.X

        Dim iStart As Integer = (l - OrigX) / ScaleX
        Dim iEnd As Integer = (r - OrigX) / ScaleX
        If iStart < 0 Then iStart = 0
        If iEnd < 0 Then iEnd = 0
        If iEnd > Data.Length - 1 Then iEnd = Data.Length - 1
        If iStart > Data.Length - 1 Then iStart = Data.Length - 1

        'Make sure that for benchmarking purposes all points are displayed, next 2 lines do not exist in real code:
        iStart = 0
        iEnd = Data.Length - 1

        If iEnd < iStart Then Continue For

        'point calculations using the pecalculated values:
        Dim APT(iEnd - iStart) As PointF
        For j = iStart To iEnd
            APT(j - iStart) = Origin + New SizeF(j * ScaleX, -(Data(j) * PS_Y))
        Next



        ImgGR.DrawLines(WFPen, APT)
        'Commenting out this line reduces the time needed for executing this whole routine from 42.4s to 4.76s
        'Hence most of the time spent even with all the scaling is still in rendering the spline.
    Next

Я пробовал подход с Direct2D, но это было даже намного медленнее, чем метод "DrawLines" в GDI:

 'Imports D2D = Microsoft.WindowsAPICodePack.DirectX.Direct2D1
'Imports DX = Microsoft.WindowsAPICodePack.DirectX
Dim TGT As D2D.RenderTarget
Private Sub initd2d()
    Dim fac As D2D.D2DFactory = D2D.D2DFactory.CreateFactory(Microsoft.WindowsAPICodePack.DirectX.Direct2D1.D2DFactoryType.SingleThreaded)

    Dim imgf As DX.WindowsImagingComponent.ImagingFactory
    imgf = DX.WindowsImagingComponent.ImagingFactory.Create

    'Dim pf As New D2D.PixelFormat(DX.Graphics.Format.B8G8R8A8UNorm, D2D.AlphaMode.Ignore)
    Dim pf As New D2D.PixelFormat(DX.Graphics.Format.Unknown, D2D.AlphaMode.Unknown)

    Dim bmp As DX.WindowsImagingComponent.ImagingBitmap
    bmp = imgf.CreateImagingBitmap(CUInt(900), CUInt(600), DX.WindowsImagingComponent.PixelFormats.Pbgra32Bpp, DX.WindowsImagingComponent.BitmapCreateCacheOption.CacheOnLoad)

    Dim rtp As New D2D.RenderTargetProperties(D2D.RenderTargetType.Default, pf, 0, 0, D2D.RenderTargetUsages.None, Microsoft.WindowsAPICodePack.DirectX.Direct3D.FeatureLevel.Default)
    TGT = fac.CreateWicBitmapRenderTarget(bmp, rtp)


    TGT.Clear(New D2D.ColorF(Color.White.ToArgb))
End Sub

'104,7s execution time:
Private Sub drawd2d()
    Dim p1 As New D2D.Point2F(1, 10.5)
    Dim p2 As New D2D.Point2F(1.01, 10)
    Dim b As D2D.Brush = TGT.CreateSolidColorBrush(New D2D.ColorF(0, 0, 255))
    TGT.BeginDraw()

    For i = 0 To 200000 * 1000
        TGT.DrawLine(p1, p2, b, 1)
    Next
End Sub

Размеры данных обычно используются в этом приложении, поэтому, пожалуйста, не спрашивайте, зачем мне это нужно.

Я также знаю, что должно быть как-то возможно отображать его намного быстрее, поскольку приложению, генерирующему данные, в первую очередь удается отобразить 4 трассы с 50M точками за 3 секунды, что примерно равно количеству данных.

Если кто-то делал что-то подобное раньше, я был бы очень признателен, если бы вы указали мне правильное направление или, если доступно, дайте мне альтернативный способ отображения PointF-Array или подобной структуры в растровое изображение.

РЕДАКТИРОВАТЬ: Пожалуйста, имейте в виду, что это процедуры BENCHMARKING, которые предназначены для выполнения тех же вычислений, что и оригинальное программное обеспечение без необходимости загружать остальную часть программы. массив Data()() динамически генерируется программным обеспечением, поэтому необходимо проверить размерность и принять меры.

Функции очистки были удалены вместе с функциями загрузки данных и отображения изображений, сетками и другим кодом, не связанным с проблемой.

EDIT2: пример кода, включая процедуру генерации данных:

    Sub Main()
    Dim T As New HiResTimer
    Dim StartTime, StopTime As Long

    'initd2d()

    PrepareData(10, 200000)



    StartTime = T.Value
    For i = 1 To 1
        'drawd2d()
        Calculate2(100, 0, 200000)
    Next
    StopTime = T.Value

    Dim Elapsed As Double = (StopTime - StartTime) / T.Frequency
    Debug.Print("Time: " & Elapsed)

End Sub

Dim aData()() As Double
Private Sub PrepareData(ByVal WaveformCount As Integer, ByVal Length As Integer)
    Dim Offset As Double = 0
    Dim Amplitude As Double = 100

    Dim SineCount As Double = 4
    Dim SineBase As Double = 2 * Math.PI / Length * SineCount

    ReDim aData(WaveformCount - 1)
    For i = 0 To WaveformCount - 1
        ReDim aData(i)(Length - 1)

        For j = 0 To Length - 1
            aData(i)(j) = Amplitude * Math.Sin(SineBase * j) + Offset + Rnd() * Amplitude * 0.05
        Next
    Next
End Sub

Private Sub Calculate2(ByVal AmplitudeUsed As Double, ByVal OffsetUsed As Double, ByVal LengthUsed As Integer)
    Dim PS_Y As Double

    'Instead of making this random, here a real calculation for the scale (chartheight / biggest waveform amplitude) :
    PS_Y = 600 / (AmplitudeUsed * 2 + AmplitudeUsed * 0.1)  ' Rnd() + 0.1

    'Since our calculation method oscillates around zero with the same amplitude we can predict that we need the following offset:
    Dim Origin As PointF = New PointF(0, 300)


    Dim Data(), ST As Double
    Dim lPoints As New List(Of PointF)

    'set the x axis scale to make our waveform fit exactly:
    Dim PS_X As Double = 900 / LengthUsed

    Dim Img As New Bitmap(900, 600)
    Dim ImgGR As Graphics = Graphics.FromImage(Img)
    ImgGR.Clear(Color.White)
    Dim WFPen As New Pen(Brushes.Black, 1)

    'theese 2 values simply define an area in the picture where the waveforms are actually visible to not overlap with the axis / legend, set it to something that makes sense
    Dim l As Integer = 20 'ChartRect.Left
    Dim r As Integer = 700 'ChartRect.Right

    For i = 0 To aData.Length - 1
        'Set sampletime to 1 second to keep the predefined scale from above, but still do the calculation as it would be needed with real data:
        ST = 1 ' Rnd()
        Data = aData(i)

        If Data.Length = 0 Then Continue For

        Dim ScaleX As Double = ST * PS_X
        Dim OrigX As Single = Origin.X

        Dim iStart As Integer = (l - OrigX) / ScaleX
        Dim iEnd As Integer = (r - OrigX) / ScaleX
        If iStart < 0 Then iStart = 0
        If iEnd < 0 Then iEnd = 0
        If iEnd > Data.Length - 1 Then iEnd = Data.Length - 1
        If iStart > Data.Length - 1 Then iStart = Data.Length - 1

        iStart = 0
        iEnd = Data.Length - 1

        If iEnd < iStart Then Continue For

        Dim APT(iEnd - iStart) As PointF
        For j = iStart To iEnd
            APT(j - iStart) = Origin + New SizeF(j * ScaleX, -(Data(j) * PS_Y))
        Next



        ImgGR.DrawLines(WFPen, APT)

    Next


    PictureBox1.Image = Img
End Sub

Answer 1

Здесь блок кода, который автоматически оптимизирует график, он не помогает для многих маленьких сигналов, но он чудесно работает с 10k и более крупными:

Private Function Calculate3(ByVal aData()() As Double, ByVal AmplitudeUsed As Double, ByVal OffsetUsed As Double, ByVal LengthUsed As Integer) As Bitmap
    Dim PS_Y As Double

    'Instead of making this random, here a real calculation for the scale (chartheight / biggest waveform amplitude) :
    PS_Y = 600 / (AmplitudeUsed * 2 + AmplitudeUsed * 0.1)  ' Rnd() + 0.1

    'Since our calculation method oscillates around zero with the same amplitude we can predict that we need the following offset:
    Dim Origin As PointF = New PointF(0, 300)


    Dim Data(), ST As Double
    Dim lPoints As New List(Of PointF)

    'set the x axis scale to make our waveform fit exactly:
    Dim PS_X As Double = 900 / LengthUsed

    Dim Img As New Bitmap(900, 600)
    Dim ImgGR As Graphics = Graphics.FromImage(Img)
    ImgGR.Clear(Color.White)
    Dim WFPen As New Pen(Brushes.Black, 1)

    'theese 2 values simply define an area in the picture where the waveforms are actually visible to not overlap with the axis / legend, set it to something that makes sense
    Dim l As Integer = 20 'ChartRect.Left
    Dim r As Integer = 700 'ChartRect.Right

    Dim APT() As PointF
    For i = 0 To aData.Length - 1
        Dim iStart As Integer
        Dim iEnd As Integer

        Dim ScaleX As Double
        Dim OrigX As Single

        'Set sampletime to 1 second to keep the predefined scale from above, but still do the calculation as it would be needed with real data:
        ST = 1 ' Rnd()
        Data = aData(i)

        If Data.Length = 0 Then Continue For

        ScaleX = ST * PS_X
        OrigX = Origin.X

        iStart = (l - OrigX) / ScaleX
        iEnd = (r - OrigX) / ScaleX
        If iStart < 0 Then iStart = 0
        If iEnd < 0 Then iEnd = 0
        If iEnd > Data.Length - 1 Then iEnd = Data.Length - 1
        If iStart > Data.Length - 1 Then iStart = Data.Length - 1

        iStart = 0
        iEnd = Data.Length - 1

        If iEnd < iStart Then Continue For

        If ScaleX < 0.3 Then 'more than 3 lines per point, summarize
            Dim iPT As Integer

            Dim FirstX As Integer
            Dim LastX As Integer

            Dim MinY As Single
            Dim MaxY As Single
            Dim tVal As Single

            Dim iSt As Integer
            Dim iEn As Integer


            FirstX = Math.Truncate(iStart * ScaleX)
            LastX = Math.Ceiling(iEnd * ScaleX)

            ReDim APT((LastX - FirstX) * 2 - 1)
            For iX = FirstX To LastX - 1
                MinY = Single.MaxValue
                MaxY = Single.MinValue

                iSt = Math.Truncate(iX / ScaleX)
                iEn = Math.Truncate((iX + 1) / ScaleX) - 1
                If iSt < 0 Then iSt = 0
                If iEn > Data.Length - 1 Then iEn = Data.Length - 1

                For iDat = iSt To iEn
                    tVal = -Data(iDat) * PS_Y
                    If tVal > MaxY Then MaxY = tVal
                    If tVal < MinY Then MinY = tVal
                Next

                iPT = (iX - FirstX) * 2
                APT(iPT) = Origin + New SizeF(iX, MinY)
                APT(iPT + 1) = Origin + New SizeF(iX, MaxY)
            Next


        Else
            ReDim APT(iEnd - iStart)
            For j = iStart To iEnd
                APT(j - iStart) = Origin + New SizeF(j * ScaleX, -(Data(j) * PS_Y))
            Next

        End If




        ImgGR.DrawLines(WFPen, APT)
    Next


    Return Img
End Function

Спасибо всем, что нашли время, чтобы прочитать мой вопрос

Answer 2

Вы можете ускорить его, проверив расстояние между точками и пропустив те, которые находятся слишком близко к предыдущей точке.

Вы можете пропустить sqrt в вычислениях расстояния и выполнить другие оптимизации, если это необходимо.

Чтобы увидеть, будет ли это полезно, попробуйте запустить тест, используя n/2 балла.