Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Description:
- Only arrays of elements of simple datatype are supported (not objects), such as numeric data, fix-len zstring, UDTs that do not involve constructors / destructors, and pointers as member fields (for example, strings are forbidden).
- The destination array must be a dynamic array (var-len) with a number of dimensions not declared or equal to that of the source array (the source array can be a fix-len array or a var-len array), but the other case where the destination array is a fix-len array also works provided that this array has the same number of dimensions and all same Lbounds and Ubounds than those of the source array.
- When the data blocks of the two arrays occupy an equal size (in bytes) in memory, the copying procedure is optimal, because there is no reallocation of the destination array in memory, but only the update of its descriptor (see Note below) and the raw copy of the data block.
- For each type of data chosen (among the simple data types), a macro defines the corresponding overloaded copy procedure.
- Another short macro with an associated function provides the address of the array descriptor.

Note:
When the data blocks of the two arrays occupy an equal size (in bytes) in memory, the reallocation/resizing of the destination array is useless.
In addition to the copy of the data block from the source array to the one of the destination array, this just also needs to copy the contents of the source array descriptor into that of the destination array, except for:
- the second field of destination array descriptor (pointer to the first real element: '@array (lbound1, lbound2, ...)') which must not be modified,
- the first field of destination array descriptor (pointer to the real or virtual element: '@array(0, 0,...)') which must be recalculated (same offset with the second field of array descriptor as for the source array).

Code: Select all

'---------- Code for quick procedure ----------
#include "crt/string.bi"

Function arrayDescriptorPtrFunction (Byval p As Any Ptr) As Any Ptr
  Return p
End function
#macro arrayDescriptorPtr(array, p)
  Scope
    Dim As Function (() As Typeof((array))) As Any Ptr f
    f = Cast(Function (() As Typeof((array))) As Any Ptr, @arrayDescriptorPtrFunction)
    p = f(array())
  End Scope
#endmacro

#macro quickArrayCopyDefine(arrayType)
  Sub quickArrayCopy Overload (dest() As arrayType, src() As arrayType)
    Type dimension
      Dim As Uinteger elementNumber
      Dim As Integer lowBound
      Dim As Integer upBound
    End Type
     
    Type descriptor
      Dim As Any Ptr ptr0
      Dim As Any Ptr ptrLbound
      Dim As Uinteger globalSize
      Dim As Uinteger elementSize
      Dim As Uinteger dimensionNumber
      Dim As dimension d(1 To 8)
    End Type
   
    Dim As descriptor Ptr pdescriptorDest
    arrayDescriptorPtr(dest, pdescriptorDest)
    Dim As descriptor Ptr pdescriptorSrc
    arrayDescriptorPtr(src, pdescriptorSrc)
   
    If pdescriptorDest <> pdescriptorSrc Then
      If (pdescriptorDest->dimensionNumber = 0) Orelse (pdescriptorDest->dimensionNumber = pdescriptorSrc->dimensionNumber) Then
        If pdescriptorSrc->globalSize = 0 Then
          Erase dest
        Else
          If pdescriptorDest->globalSize <> pdescriptorSrc->globalSize Then
            Select Case As Const pdescriptorSrc->dimensionNumber
            Case 1
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound)
            Case 2
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound)
            Case 3
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound)
            Case 4
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound)
            Case 5
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound)
            Case 6
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound)
            Case 7
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound)
            Case 8
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound, _
                         pdescriptorSrc->d(8).lowBound To pdescriptorSrc->d(8).upBound)
            End Select
          Else
            Dim As Any Ptr ptrLbound = pdescriptorDest->ptrLbound
            memcpy(pdescriptorDest, pdescriptorSrc, Offsetof(descriptor, d(pdescriptorSrc->dimensionNumber)) + Sizeof(dimension))
            pdescriptorDest->ptrLbound = ptrLbound
            pdescriptorDest->ptr0 = ptrLbound + (pdescriptorSrc->ptr0 - pdescriptorSrc->ptrLbound)
          End If
          memcpy(pdescriptorDest->ptrLbound, pdescriptorSrc->ptrLbound, pdescriptorSrc->globalSize)
        End If
      End If
    End If
  End Sub
#endmacro
'----------------------------------------------

'---------- Example 1 ----------
Dim As Short arrays1(1 To 8, 1 To 5)
For I As Integer = Lbound(arrays1, 1) To Ubound(arrays1, 1)
  For J As Integer = Lbound(arrays1, 2) To Ubound(arrays1, 2)
    arrays1(I,J) = 10 * I + J
  Next J
Next I
Redim As Short arrays2()

quickArrayCopyDefine(Short)

Print "Initial address of destination array: " & @arrays2(Lbound(arrays2, 1), Lbound(arrays2, 2))
quickArrayCopy(arrays2(), arrays1())
Print "Final address of destination array  : " & @arrays2(Lbound(arrays2, 1), Lbound(arrays2, 2))
Erase arrays1

For I As Integer = Lbound(arrays2, 1) To Ubound(arrays2, 1)
  For J As Integer = Lbound(arrays2, 2) To Ubound(arrays2, 2)
    Print "(" & I & "," & J & ")=" & arrays2(I, J),
  Next J
  Print
Next I
Print
'-------------------------------

'---------- Example 2 ----------
Dim As Zstring* 3 arrayz1(1 To 8, 1 To 5)
For I As Integer = Lbound(arrayz1, 1) To Ubound(arrayz1, 1)
  For J As Integer = Lbound(arrayz1, 2) To Ubound(arrayz1, 2)
    arrayz1(I,J) = Chr(64 + I) & Chr(96 + J)
  Next J
Next I
Redim As Zstring * 3 arrayz2(-2 To 5, -3 To 1)

quickArrayCopyDefine(Zstring * 3)

Print "Initial address of destination array: " & @arrayz2(Lbound(arrayz2, 1), Lbound(arrayz2, 2))
quickArrayCopy(arrayz2(), arrayz1())
Print "Final address of destination array  : " & @arrayz2(Lbound(arrayz2, 1), Lbound(arrayz2, 2))
Erase arrayz1

For I As Integer = Lbound(arrayz2, 1) To Ubound(arrayz2, 1)
  For J As Integer = Lbound(arrayz2, 2) To Ubound(arrayz2, 2)
    Print "(" & I & "," & J & ")=" & arrayz2(I, J),
  Next J
  Print
Next I
Print
'-------------------------------

Sleep

Code: Select all

Initial address of destination array: 0
Final address of destination array  : 8989312
(1,1)=11      (1,2)=12      (1,3)=13      (1,4)=14      (1,5)=15
(2,1)=21      (2,2)=22      (2,3)=23      (2,4)=24      (2,5)=25
(3,1)=31      (3,2)=32      (3,3)=33      (3,4)=34      (3,5)=35
(4,1)=41      (4,2)=42      (4,3)=43      (4,4)=44      (4,5)=45
(5,1)=51      (5,2)=52      (5,3)=53      (5,4)=54      (5,5)=55
(6,1)=61      (6,2)=62      (6,3)=63      (6,4)=64      (6,5)=65
(7,1)=71      (7,2)=72      (7,3)=73      (7,4)=74      (7,5)=75
(8,1)=81      (8,2)=82      (8,3)=83      (8,4)=84      (8,5)=85

Initial address of destination array: 8989400
Final address of destination array  : 8989400
(1,1)=Aa      (1,2)=Ab      (1,3)=Ac      (1,4)=Ad      (1,5)=Ae
(2,1)=Ba      (2,2)=Bb      (2,3)=Bc      (2,4)=Bd      (2,5)=Be
(3,1)=Ca      (3,2)=Cb      (3,3)=Cc      (3,4)=Cd      (3,5)=Ce
(4,1)=Da      (4,2)=Db      (4,3)=Dc      (4,4)=Dd      (4,5)=De
(5,1)=Ea      (5,2)=Eb      (5,3)=Ec      (5,4)=Ed      (5,5)=Ee
(6,1)=Fa      (6,2)=Fb      (6,3)=Fc      (6,4)=Fd      (6,5)=Fe
(7,1)=Ga      (7,2)=Gb      (7,3)=Gc      (7,4)=Gd      (7,5)=Ge
(8,1)=Ha      (8,2)=Hb      (8,3)=Hc      (8,4)=Hd      (8,5)=He
Related topics:
- How accessing to the array's descriptor structure?
- Simplistic copy for dynamic array fields when assigning between UDT instances


[edit]
"arrayCopy..." renamed to "quickArrayCopy..."
Last edited by fxm on Aug 10, 2018 6:18, edited 10 times in total.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by Tourist Trap »

Hi, looks great!

3 questions I have...

Does it work with multi-dimension arrays?
Have some testing been done to compare the time consumed in a standard copy and this procedure?
Why doesn't it work with constructable udts?

Thanks however for this tip, I guess that this is more efficent by far than the standard copy index to index.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Tourist Trap wrote:Does it work with multi-dimension arrays?
Yes, any number of dimensions among those supported by arrays (from 0 to 8 dimensions).
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Tourist Trap wrote:Have some testing been done to compare the time consumed in a standard copy and this procedure?
In progress.

[edit]
See at viewtopic.php?p=250324#p250324.
Last edited by fxm on Aug 06, 2018 7:58, edited 1 time in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Tourist Trap wrote:Why doesn't it work with constructable udts?
When the array elements are objects, the assignment must be executed element by element in order to call the Let Operator on each object (a simple memory block copy fails).

For example, for an array of strings, it would be the string descriptors that would be copied and not the string characters themselves.
The destination array would then refer to the same string characters in memory, due to the erroneous duplication of the string descriptors instead of the string characters.
Last edited by fxm on Aug 06, 2018 8:32, edited 2 times in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Comparison between this quick procedure for copying array and a standard procedure for copying array:

Code: Select all

'---------- Code for quick procedure ----------
#include "crt/string.bi"

Function arrayDescriptorPtrFunction (Byval p As Any Ptr) As Any Ptr
  Return p
End function
#macro arrayDescriptorPtr(array, p)
  Scope
    Dim As Function (() As Typeof((array))) As Any Ptr f
    f = Cast(Function (() As Typeof((array))) As Any Ptr, @arrayDescriptorPtrFunction)
    p = f(array())
  End Scope
#endmacro

#macro quickArrayCopyDefine(arrayType)
  Sub quickArrayCopy Overload (dest() As arrayType, src() As arrayType)
    Type dimension
      Dim As Uinteger elementNumber
      Dim As Integer lowBound
      Dim As Integer upBound
    End Type
     
    Type descriptor
      Dim As Any Ptr ptr0
      Dim As Any Ptr ptrLbound
      Dim As Uinteger globalSize
      Dim As Uinteger elementSize
      Dim As Uinteger dimensionNumber
      Dim As dimension d(1 To 8)
    End Type
   
    Dim As descriptor Ptr pdescriptorDest
    arrayDescriptorPtr(dest, pdescriptorDest)
    Dim As descriptor Ptr pdescriptorSrc
    arrayDescriptorPtr(src, pdescriptorSrc)
   
    If pdescriptorDest <> pdescriptorSrc Then
      If (pdescriptorDest->dimensionNumber = 0) Orelse (pdescriptorDest->dimensionNumber = pdescriptorSrc->dimensionNumber) Then
        If pdescriptorSrc->globalSize = 0 Then
          Erase dest
        Else
          If pdescriptorDest->globalSize <> pdescriptorSrc->globalSize Then
            Select Case As Const pdescriptorSrc->dimensionNumber
            Case 1
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound)
            Case 2
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound)
            Case 3
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound)
            Case 4
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound)
            Case 5
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound)
            Case 6
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound)
            Case 7
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound)
            Case 8
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound, _
                         pdescriptorSrc->d(8).lowBound To pdescriptorSrc->d(8).upBound)
            End Select
          Else
            Dim As Any Ptr ptrLbound = pdescriptorDest->ptrLbound
            memcpy(pdescriptorDest, pdescriptorSrc, Offsetof(descriptor, d(pdescriptorSrc->dimensionNumber)) + Sizeof(dimension))
            pdescriptorDest->ptrLbound = ptrLbound
            pdescriptorDest->ptr0 = ptrLbound + (pdescriptorSrc->ptr0 - pdescriptorSrc->ptrLbound)
          End If
          memcpy(pdescriptorDest->ptrLbound, pdescriptorSrc->ptrLbound, pdescriptorSrc->globalSize)
        End If
      End If
    End If
  End Sub
#endmacro
'----------------------------------------------

'---------- Code for standard procedure ----------
#macro standardArrayCopyDefine(arrayType)
  Sub standardArrayCopy Overload (dest() As arrayType, src() As arrayType)
    If (Ubound(dest, 0) = 0) Orelse (Ubound(dest, 0) = Ubound(src, 0)) Then
      If @src(Lbound(src)) = 0 Then
        Erase dest
      Else
        Select Case As Const Ubound(src, 0)
        Case 1
          Redim dest(Lbound(src, 1) To Ubound(src, 1))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            dest(I1) = src(I1)
          Next I1
        Case 2
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              dest(I1, I2) = src(I1, I2)
            Next I2
          Next I1
        Case 3
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                dest(I1, I2, I3) = src(I1, I2, I3)
              Next I3
            Next I2
          Next I1
        Case 4
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  dest(I1, I2, I3, I4) = src(I1, I2, I3, I4)
                Next I4
              Next I3
            Next I2
          Next I1
        Case 5
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    dest(I1, I2, I3, I4, I5) = src(I1, I2, I3, I4, I5)
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 6
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      dest(I1, I2, I3, I4, I5, I6) = src(I1, I2, I3, I4, I5, I6)
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 7
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6), _
                     Lbound(src, 7) To Ubound(src, 7))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      For I7 As Integer = Lbound(src, 7) To Ubound(src, 7)
                        dest(I1, I2, I3, I4, I5, I6, I7) = src(I1, I2, I3, I4, I5, I6, I7)
                      Next I7
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 8
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6), _
                     Lbound(src, 7) To Ubound(src, 7), _
                     Lbound(src, 8) To Ubound(src, 8))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      For I7 As Integer = Lbound(src, 7) To Ubound(src, 7)
                        For I8 As Integer = Lbound(src, 8) To Ubound(src, 8)
                          dest(I1, I2, I3, I4, I5, I6, I7, I8) = src(I1, I2, I3, I4, I5, I6, I7, I8)
                        Next I8
                      Next I7
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        End Select
      End If
    End If
  End Sub
#endmacro
'-------------------------------------------------

Dim As Double t
Dim As Integer N = 250000000  '' 2 arrays, so about 0.5 GB in total
Dim As Byte a1(), a2(), K = 123
Dim As Byte Ptr address2

quickArrayCopyDefine(Byte)
standardArrayCopyDefine(Byte)

Redim a1(N)

#macro test(arrayCopy, title)
  a1(N) = K
  address2 = @a2(Lbound(a2))
  Sleep 1000
  t = Timer
  ##arrayCopy(a2(), a1())
  t = Timer - t
  Print title,
  a1(N) = 0
  If a2(N) = K Then
    Print Cast(Single, t) & " seconds",
    If address2 = 0 And @a2(Lbound(a2)) <> 0 Then
      Print "array created in memory"
    Elseif address2 = @a2(Lbound(a2)) Then
      Print "array unmoved in memory"
    Else
      Print "array moved in memory"
    End If
  Else
    Print "Copying failed"
  End If
#endmacro

Print "Copying from an N sized source array to an unsized destination array"
test(standardArrayCopy, "  Standard copy")
Erase a2
test(quickArrayCopy, "  Quick copy   ")
Print

Redim a2(Int(N/2))
Print "Copying from an N sized source array to a smaller total sized destination array"
test(standardArrayCopy, "  Standard copy")
Redim a2(Int(N/2))
test(quickArrayCopy, "  Quick copy   ")
Print

Redim a2(-Int(N/2) To N-Int(N/2))
Print "Copying from an N sized source array to an equal total sized destination array"
test(standardArrayCopy, "  Standard copy")
Redim a2(-Int(N/2) To N-Int(N/2))
test(quickArrayCopy, "  Quick copy   ")
Print

Sleep
On average:

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard copy             0.8203107 seconds           array created in memory
  Quick copy                0.1006872 seconds           array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard copy             0.7036415 seconds           array moved in memory
  Quick copy                0.1144618 seconds           array moved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard copy             0.7181659 seconds           array moved in memory
  Quick copy                0.07739966 seconds          array unmoved in memory
[edit]
- Added a test to check if the destination table was created/moved into memory by the copy procedure.
- "arrayCopy..." renamed to "quickArrayCopy...".
- Forgotten the 'Overload' qualifier for the 'StandardArrayCopy()' procedure, to be compatible for using several datatypes in the same program.
- 't' variable for Timer must be declared as Double.
Last edited by fxm on Aug 08, 2018 18:48, edited 6 times in total.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by Tourist Trap »

@fxm,

thanks for explaining. I launched the test. As you can see I'm on a rather crappy machine those days. I needed excel2007 so I took a old and dirty thing running painfully win7. This leads to those results for me (still the same advantage ratio for your quick copy of course when we compare the 2 methods):
Copying from an N sized source array to an unsized destination array
Standard copy 18.3743 seconds array created in memory
Quick copy 0.6295455 seconds array created in memory

Copying from an N sized source array to a smaller total sized destination array
Standard copy 17.48306 seconds array unmoved in memory
Quick copy 0.6086323 seconds array unmoved in memory

Copying from an N sized source array to an equal total sized destination array
Standard copy 17.94972 seconds array unmoved in memory
Quick copy 0.5954745 seconds array unmoved in memory
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Your improvement ratio is higher than mine.
Have you compiled with the "-exx" option?
If yes, this disadvantages the 'standardArrayCopy()' procedure!
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by Tourist Trap »

fxm wrote: Have you compiled with the "-exx" option?
Yes. Without it, I have "better" performances (I have a really slow computer here):
Copying from an N sized source array to an unsized destination array
Standard copy 7.077014 seconds array created in memory
Quick copy 0.7545342 seconds array created in memory

Copying from an N sized source array to a smaller total sized destination array
Standard copy 5.002829 seconds array unmoved in memory
Quick copy 0.6017742 seconds array unmoved in memory

Copying from an N sized source array to an equal total sized destination array
Standard copy 4.980256 seconds array unmoved in memory
Quick copy 0.5989835 seconds array unmoved in memory
An amusing conclusion. Just by using an excellent programming trick, I can perform the array copy on my crap computer just as fast you do without trick in your modern one. This is a noticeable illustration of what programming skill means in term of jump of performance.I'm on an old centrino with windows performance indice of 2 (and it probably means less)...
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by jj2007 »

Results on a Core i5:

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard copy             0.9390069 seconds           array created in memory
  Quick copy                0.06993096 seconds          array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard copy             0.6999074 seconds           array unmoved in memory
  Quick copy                0.1086049 seconds           array unmoved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard copy             0.746541 seconds            array unmoved in memory
  Quick copy                0.1468594 seconds           array unmoved in memory
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by badidea »

I beat you all:

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard copy             -59.74995 seconds           array created in memory
  Quick copy                -58.64744 seconds           array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard copy             -56.97449 seconds           array moved in memory
  Quick copy                -55.83194 seconds           array moved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard copy             -54.16702 seconds           array unmoved in memory
  Quick copy                -53.05639 seconds           array unmoved in memory
Please use double for timer :-)
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by srvaldez »

badidea wrote:Please use double for timer :-)
agree, the numbers I got when using single

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard copy             -24.26079 seconds           array created in memory
  Quick copy                -22.9967 seconds            array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard copy             -21.2092 seconds            array moved in memory
  Quick copy                -19.88056 seconds           array moved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard copy             -18.10245 seconds           array unmoved in memory
  Quick copy                -16.83821 seconds           array unmoved in memory
when using Double

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard copy             0.6938760280609131 seconds  array created in memory
  Quick copy                0.1604659557342529 seconds  array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard copy             0.6915178298950195 seconds  array moved in memory
  Quick copy                0.1683149337768555 seconds  array moved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard copy             0.6926851272583008 seconds  array unmoved in memory
  Quick copy                0.1636359691619873 seconds  array unmoved in memory
Mac with 2 Intel Xeon 2.66 GHz 6-Core Processors
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

badidea wrote:Please use double for timer :-)
Yes, my mistake, thank you.
Code updated.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

Below an extending of the previous 'quickArrayCopy(arrayType)' macro that I named 'enhancedArrayCopy(arrayType, copyType)'.
In addition of the first 'arrayType' parameter, I added a second 'copyType' parameter which can be only equal either to 'shallow' or 'deep':
- 'shallow': to copy the memory block occupied by all array elements in one go (macro-generated procedure: 'shallowArrayCopy()', same as the previous 'quickArrayCopy()').
- 'deep': to copy element by element but in a single loop whatever the number of dimensions of the array (therefore using the assignment operator, adapted to the array type).

- 'shallow' procedure is sufficient for an array type without objects as elements (simple data types).
- 'deep' procedure is recommended for an array type with objects as elements (more complex data types).

Comparison between the 3 copy methods: standard, shallow (same as previous quick), and deep, for a Byte array:

Code: Select all

'---------- Code for enhanced (shallow/deep) procedure ----------
#include "crt/string.bi"

Function arrayDescriptorPtrFunction (Byval p As Any Ptr) As Any Ptr
  Return p
End function
#macro arrayDescriptorPtr(array, p)
  Scope
    Dim As Function (() As Typeof((array))) As Any Ptr f
    f = Cast(Function (() As Typeof((array))) As Any Ptr, @arrayDescriptorPtrFunction)
    p = f(array())
  End Scope
#endmacro

#macro enhancedArrayCopyDefine(arrayType, copyType)  '' copyType = shallow / deep
  Sub copyType##ArrayCopy Overload (dest() As arrayType, src() As arrayType)
    Type dimension
      Dim As Uinteger elementNumber
      Dim As Integer lowBound
      Dim As Integer upBound
    End Type
     
    Type descriptor
      Dim As Any Ptr ptr0
      Dim As Any Ptr ptrLbound
      Dim As Uinteger globalSize
      Dim As Uinteger elementSize
      Dim As Uinteger dimensionNumber
      Dim As dimension d(1 To 8)
    End Type
   
    Dim As descriptor Ptr pdescriptorDest
    arrayDescriptorPtr(dest, pdescriptorDest)
    Dim As descriptor Ptr pdescriptorSrc
    arrayDescriptorPtr(src, pdescriptorSrc)
   
    If pdescriptorDest <> pdescriptorSrc Then
      If (pdescriptorDest->dimensionNumber = 0) Orelse (pdescriptorDest->dimensionNumber = pdescriptorSrc->dimensionNumber) Then
        If pdescriptorSrc->globalSize = 0 Then
          Erase dest
        Else
          If pdescriptorDest->globalSize <> pdescriptorSrc->globalSize Then
            Select Case As Const pdescriptorSrc->dimensionNumber
            Case 1
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound)
            Case 2
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound)
            Case 3
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound)
            Case 4
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound)
            Case 5
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound)
            Case 6
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound)
            Case 7
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound)
            Case 8
              Redim dest(pdescriptorSrc->d(1).lowBound To pdescriptorSrc->d(1).upBound, _
                         pdescriptorSrc->d(2).lowBound To pdescriptorSrc->d(2).upBound, _
                         pdescriptorSrc->d(3).lowBound To pdescriptorSrc->d(3).upBound, _
                         pdescriptorSrc->d(4).lowBound To pdescriptorSrc->d(4).upBound, _
                         pdescriptorSrc->d(5).lowBound To pdescriptorSrc->d(5).upBound, _
                         pdescriptorSrc->d(6).lowBound To pdescriptorSrc->d(6).upBound, _
                         pdescriptorSrc->d(7).lowBound To pdescriptorSrc->d(7).upBound, _
                         pdescriptorSrc->d(8).lowBound To pdescriptorSrc->d(8).upBound)
            End Select
          Else
            Dim As Any Ptr ptrLbound = pdescriptorDest->ptrLbound
            memcpy(pdescriptorDest, pdescriptorSrc, Offsetof(descriptor, d(pdescriptorSrc->dimensionNumber)) + Sizeof(dimension))
            pdescriptorDest->ptrLbound = ptrLbound
            pdescriptorDest->ptr0 = ptrLbound + (pdescriptorSrc->ptr0 - pdescriptorSrc->ptrLbound)
          End If
          #if copyType = shallow
            memcpy(pdescriptorDest->ptrLbound, pdescriptorSrc->ptrLbound, pdescriptorSrc->globalSize)
          #endif
          #if copyType = deep
            Dim As arrayType Ptr pSrc = pdescriptorSrc->ptrLbound, pDest = pdescriptorDest->ptrLbound
            For I As Integer = 0 To pdescriptorSrc->globalSize \ pdescriptorSrc->elementSize - 1
              pDest[I] = pSrc[I]
            Next I
          #endif
        End If
      End If
    End If
  End Sub
#endmacro
'----------------------------------------------------------------

'---------- Code for standard procedure ----------
#macro standardArrayCopyDefine(arrayType)
  Sub standardArrayCopy Overload (dest() As arrayType, src() As arrayType)
    If (Ubound(dest, 0) = 0) Orelse (Ubound(dest, 0) = Ubound(src, 0)) Then
      If @src(Lbound(src)) = 0 Then
        Erase dest
      Else
        Select Case As Const Ubound(src, 0)
        Case 1
          Redim dest(Lbound(src, 1) To Ubound(src, 1))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            dest(I1) = src(I1)
          Next I1
        Case 2
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              dest(I1, I2) = src(I1, I2)
            Next I2
          Next I1
        Case 3
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                dest(I1, I2, I3) = src(I1, I2, I3)
              Next I3
            Next I2
          Next I1
        Case 4
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  dest(I1, I2, I3, I4) = src(I1, I2, I3, I4)
                Next I4
              Next I3
            Next I2
          Next I1
        Case 5
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    dest(I1, I2, I3, I4, I5) = src(I1, I2, I3, I4, I5)
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 6
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      dest(I1, I2, I3, I4, I5, I6) = src(I1, I2, I3, I4, I5, I6)
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 7
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6), _
                     Lbound(src, 7) To Ubound(src, 7))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      For I7 As Integer = Lbound(src, 7) To Ubound(src, 7)
                        dest(I1, I2, I3, I4, I5, I6, I7) = src(I1, I2, I3, I4, I5, I6, I7)
                      Next I7
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        Case 8
          Redim dest(Lbound(src, 1) To Ubound(src, 1), _
                     Lbound(src, 2) To Ubound(src, 2), _
                     Lbound(src, 3) To Ubound(src, 3), _
                     Lbound(src, 4) To Ubound(src, 4), _
                     Lbound(src, 5) To Ubound(src, 5), _
                     Lbound(src, 6) To Ubound(src, 6), _
                     Lbound(src, 7) To Ubound(src, 7), _
                     Lbound(src, 8) To Ubound(src, 8))
          For I1 As Integer = Lbound(src, 1) To Ubound(src, 1)
            For I2 As Integer = Lbound(src, 2) To Ubound(src, 2)
              For I3 As Integer = Lbound(src, 3) To Ubound(src, 3)
                For I4 As Integer = Lbound(src, 4) To Ubound(src, 4)
                  For I5 As Integer = Lbound(src, 5) To Ubound(src, 5)
                    For I6 As Integer = Lbound(src, 6) To Ubound(src, 6)
                      For I7 As Integer = Lbound(src, 7) To Ubound(src, 7)
                        For I8 As Integer = Lbound(src, 8) To Ubound(src, 8)
                          dest(I1, I2, I3, I4, I5, I6, I7, I8) = src(I1, I2, I3, I4, I5, I6, I7, I8)
                        Next I8
                      Next I7
                    Next I6
                  Next I5
                Next I4
              Next I3
            Next I2
          Next I1
        End Select
      End If
    End If
  End Sub
#endmacro
'-------------------------------------------------

Dim As Double t
Dim As Integer N = 250000000  '' 2 arrays, so about 0.5 GB in total
Dim As Byte a1(), a2(), K = 123
Dim As Byte Ptr address2

standardArrayCopyDefine(Byte)
enhancedArrayCopyDefine(Byte, shallow)
enhancedArrayCopyDefine(Byte, deep)

Redim a1(N)

#macro test(arrayCopy, title)
  a1(N) = K
  address2 = @a2(Lbound(a2))
  Sleep 1000
  t = Timer
  ##arrayCopy(a2(), a1())
  t = Timer - t
  Print title,
  a1(N) = 0
  If a2(N) = K Then
    Print Cast(Single, t) & " seconds",
    If address2 = 0 And @a2(Lbound(a2)) <> 0 Then
      Print "array created in memory"
    Elseif address2 = @a2(Lbound(a2)) Then
      Print "array unmoved in memory"
    Else
      Print "array moved in memory"
    End If
  Else
    Print "Copying failed"
  End If
#endmacro

Print "Copying from an N sized source array to an unsized destination array"
test(standardArrayCopy, "  Standard (deep) copy")
Erase a2
test(shallowArrayCopy, "  Enhanced shallow copy")
Erase a2
test(deepArrayCopy, "  Enhanced deep copy")
Print

Redim a2(Int(N/2))
Print "Copying from an N sized source array to a smaller total sized destination array"
test(standardArrayCopy, "  Standard (deep) copy")
Redim a2(Int(N/2))
test(shallowArrayCopy, "  Enhanced shallow copy")
Redim a2(Int(N/2))
test(deepArrayCopy, "  Enhanced deep copy")
Print

Redim a2(-Int(N/2) To N-Int(N/2))
Print "Copying from an N sized source array to an equal total sized destination array"
test(standardArrayCopy, "  Standard (deep) copy")
Redim a2(-Int(N/2) To N-Int(N/2))
test(shallowArrayCopy, "  Enhanced shallow copy")
Redim a2(-Int(N/2) To N-Int(N/2))
test(deepArrayCopy, "  Enhanced deep copy")
Print

Sleep
On average:

Code: Select all

Copying from an N sized source array to an unsized destination array
  Standard (deep) copy      0.7650509 seconds           array created in memory
  Enhanced shallow copy     0.08640789 seconds          array created in memory
  Enhanced deep copy        0.6726552 seconds           array created in memory

Copying from an N sized source array to a smaller total sized destination array
  Standard (deep) copy      0.7049895 seconds           array moved in memory
  Enhanced shallow copy     0.088287 seconds            array moved in memory
  Enhanced deep copy        0.6752244 seconds           array moved in memory

Copying from an N sized source array to an equal total sized destination array
  Standard (deep) copy      0.7062382 seconds           array moved in memory
  Enhanced shallow copy     0.08582361 seconds          array unmoved in memory
  Enhanced deep copy        0.6791479 seconds           array unmoved in memory
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Quick Procedure for Copying Array of Simple DataType into a Dynamic Array

Post by fxm »

In relation with the above code, a macro to determine if a type instance must be copied with a "deep" copy method or if a "shallow" copy method is sufficient:

Code: Select all

#macro typeCopyMethod(typesymbol, typeCopyMethodResult)
  '' Determine if the type instances can be copied with a "shallow" method
  ''    or if a "deep" method is sufficient:
  ''       The principe is:
  ''          - if the type does not have a destructor then "shallow" copy method,
  ''               otherwise "deep" copy method,
  ''          - to determine if the type has a destructor (implicit or explicit),
  ''               the principle is to apply the New [] operator on an UDT
  ''               containing a data member of this type and to test if an Integer
  ''               (to store the number of instances to destroy)
  ''               is added at head of the memory allocation for the instances
  ''               (memory allocation address <> type instances address),
  ''          - therefore, if the user defines his own Let (assignment) operator,
  ''               he must also define a destructor even with an empty body
  ''               if there is no already an implicit destructor.
 
  '' typesymbol must be a symbol name different for each macro called,
  ''    either the type name itself if it's a symbol name, or an alias,
  '' typeCopyMethodResult must be a String variable to get "shallow" or "deep"
  ''    or a 'string * 7' variable, or a '(Z/W)string * 8 variable.
 
  Type typesymbol##UDT
    Public:
      Declare Constructor ()
      Declare Operator Delete [] (Byval allocationPointer As Any Ptr)
      Static As Boolean hasDestructor
    Private:
      Dim As typesymbol typesymbolVariable
      Static As Any Ptr instancePointer
  End Type
 
  Dim As Any Ptr typesymbol##UDT.instancePointer
  Dim As Boolean typesymbol##UDT.hasDestructor
 
  Constructor typesymbol##UDT ()
    typesymbol##UDT.instancePointer = @This
  End Constructor
 
  Operator typesymbol##UDT.Delete [] (Byval allocationPointer As Any Ptr)
    typesymbol##UDT.hasDestructor = (allocationPointer <> typesymbol##UDT.instancePointer)
    Deallocate(allocationPointer)
  End Operator
 
  Dim As typesymbol##UDT Ptr typesymbol##UDT##p = New typesymbol##UDT[1]
  Delete [] typesymbol##UDT##p
  If typesymbol##UDT.hasDestructor Then
    typeCopyMethodResult = "deep"
  Else
    typeCopyMethodResult = "shallow"
  End If

#endmacro


Dim As String integerTypeCopyMethod
  typeCopyMethod(Integer, integerTypeCopyMethod)

Dim As String stringTypeCopyMethod
  typeCopyMethod(String, stringTypeCopyMethod)

Type string10Type As String * 10  '' define an alias to get a symbol name
Dim As String string10TypeCopyMethod
  typeCopyMethod(string10Type, string10TypeCopyMethod)

Type stringptrType As String Ptr  '' define an alias to get a symbol name
Dim As String stringptrTypeCopyMethod
  typeCopyMethod(stringptrType, stringptrTypeCopyMethod)

Dim As String objectTypeCopyMethod
  typeCopyMethod(Object, objectTypeCopyMethod)

Type UDT1 Extends Object
End Type
Dim As String UDT1TypeCopyMethod
  typeCopyMethod(UDT1, UDT1TypeCopyMethod)

Type UDT2 Extends Object
  Declare Destructor ()
End Type
Destructor UDT2 ()
End Destructor
Dim As String UDT2TypeCopyMethod
  typeCopyMethod(UDT2, UDT2TypeCopyMethod)

Print "The 'Integer' type can be copied with the following method: ", integerTypeCopyMethod
Print "The 'String' type can be copied with the following method: ", stringTypeCopyMethod
Print "The 'String * 10' type can be copied with the following method: ", string10TypeCopyMethod
Print "The 'String Ptr' type can be copied with the following method: ", stringptrTypeCopyMethod
Print "The 'Object' type can be copied with the following method: ", objectTypeCopyMethod
Print "The 'UDT1' user-type can be copied with the following method: ", UDT1TypeCopyMethod
Print "The 'UDT2' user-type can be copied with the following method: ", UDT2TypeCopyMethod
Print

Sleep

Code: Select all

The 'Integer' type can be copied with the following method:           shallow
The 'String' type can be copied with the following method:            deep
The 'String * 10' type can be copied with the following method:       shallow
The 'String Ptr' type can be copied with the following method:        shallow
The 'Object' type can be copied with the following method:            shallow
The 'UDT1' user-type can be copied with the following method:         shallow
The 'UDT2' user-type can be copied with the following method:         deep
Post Reply