New array features

For other topics related to the FreeBASIC project or its community.
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

New array features

Postby Juergen Kuehlwein » May 13, 2019 17:27

Jeff is currently reviewing and re-working my pull request for (among others) a seamless integration of a dynamic wide string type, which is coded in form of a class-like UDT. Discussion is in this thread. Because there is a massive amount of changes and additions in this pull request, Jeff decided to split it up and to omit the additions. One of these additions is an extension of array features (sort, insert, delete elements), which (referring to this post) will now be discussed here.


- this looks like a workaround to a missing compiler feature; but could this be implemented better?
...
What about VARPTR( array )? Any conflicts or ambiguity?


Fxm´s code is a clever workaround for a missing feature. Currently you can use VARPTR for retrieving a pointer to an array´s elements, but you cannot retrieve the array´s descriptor with VARPTR. I already coded the necessary changes for the compiler to return this pointer with VARPTR: p = @array, or p = VARPTR(array). It implements the same syntax as U/LBOUND: array variable without index. As far as i can tell, fxm´s structure definition here for the array descriptor is correct.


Before making a new pull request i would like to know, what would be the preferred/best way of implementing the new array features (sort, insert, delete). I see three ways to go:

1.) as is - add it as include file (definitions and run time code in array.bi). The features are available only, if array.bi is included. This makes everything acessible to the user.

2.) add only the definitions to array.bi, and add the code to the runtime library, which still requires array.bi to be included for making the features available (just like file.bi). This keeps parts of the low level stuff away from the user

3.) add it to the compiler (new keywords etc.) and add the actual code to the runtime library, which makes an include file (array.bi) obsolete. This keeps all the low level stuff away from the user

Obviously #1 is easiest and compared to other features not an unusual way. What do you think, how should i procede?


JK
fxm
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 13, 2019 18:10

To add what features do you want to directly access / modify array descriptors?
I think that this can only concern the resizable arrays, because in this only case, the descriptor is the reference of the characteristics of the array.
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 13, 2019 22:05

In my view FB in general lacks array and string handling functions. To name it for arrays i miss a sorting function, i miss a method of inserting elements into existing arrays and deleting elements. The more a fast searching function scanning the whole array (or parts of it) for a value would be of help.

I tried to address the first three (sort, insert and delete) with the following code (array.bi) :

Code: Select all

#include once "ustring.bi"
#INCLUDE ONCE "/crt/string.bi"
#INCLUDE ONCE "/crt/stdlib.bi"


#pragma once


'***********************************************************************************************
' Copyright (c) 2019 Juergen Kuehlwein
' Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ****************************************************************************************


' array_sort    - sort all kinds of arrays in many ways including custom sort
' array_insert  - insert an element into an one-dimensional array an assign a value to it
' array_delete  - delete an element of an one-dimensional array and close the gap


'***********************************************************************************************
' prototype of a custom sort procedure:
' it must be CDECL, and you must choose the corresponding data type (zstring is just an example)
'***********************************************************************************************


'PRIVATE FUNCTION CustomSortProc CDECL (BYVAL a AS zstring PTR, BYVAL b AS zstring PTR) AS LONG
''***********************************************************************************************
'' qsort custom comparison function
'' return  1, if a should precede b in sorting
'' return -1, if b should precede a in sorting
'' return  0, if both are equal
'' for UDT: compare member variable(s) to get the desired order
''***********************************************************************************************
'
'  if ucase(*a) > ucase(*b) then                       'make it case insensitive
'  if *a > *b then                                     'case sensitive
'    return 1
'  elseif *a < *b then
'    return -1
'  else
'    return 0
'  end if 
'
'
'END FUNCTION


' You may implement other predefined string sorting functions like: CompareStringEx

' CompareStringEx returns one of the following values if successful: 1,2,3 To maintain the C runtime
' convention of comparing strings, the value 2 can be subtracted from a nonzero return value.
' Then, the meaning of <0, ==0, and >0 is consistent with the C runtime.
' CSTR_LESS_THAN (-1). The string indicated by a is less in lexical value than the string indicated by b.
' CSTR_EQUAL (0). The string indicated by a is equivalent in lexical value to the string indicated by b.
' The two strings are equivalent for sorting purposes, although not necessarily identical.
' CSTR_GREATER_THAN (1). The string indicated by a is greater in lexical value than the string indicated by b.

' The function returns 0 if it does not succeed. To get extended error information, the application
' can call GetLastError, which can return one of the following error codes:
' ERROR_INVALID_FLAGS. The values supplied for flags were invalid.
' ERROR_INVALID_PARAMETER. Any of the parameter values was invalid.

'***********************************************************************************************
'***********************************************************************************************


#macro AC_SORT(a, b)
  if *a > *b then
    return 1
  elseif *a < *b then
    return -1
  else
    return 0
  end if 
#endmacro


PRIVATE FUNCTION AC_Byte CDECL (BYVAL a AS Byte PTR, BYVAL b AS Byte PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UByte CDECL (BYVAL a AS uByte PTR, BYVAL b AS uByte PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Short CDECL (BYVAL a AS Short PTR, BYVAL b AS Short PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UShort CDECL (BYVAL a AS UShort PTR, BYVAL b AS UShort PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Integer CDECL (BYVAL a AS Integer PTR, BYVAL b AS Integer PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UInteger CDECL (BYVAL a AS UInteger PTR, BYVAL b AS UInteger PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Long CDECL (BYVAL a AS Long PTR, BYVAL b AS Long PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ULong CDECL (BYVAL a AS ULong PTR, BYVAL b AS ULong PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Longint CDECL (BYVAL a AS Longint PTR, BYVAL b AS Longint PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ULongint CDECL (BYVAL a AS ULongint PTR, BYVAL b AS ULongint PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Single CDECL (BYVAL a AS Single PTR, BYVAL b AS Single PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Double CDECL (BYVAL a AS Double PTR, BYVAL b AS Double PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ZString CDECL (BYVAL a AS ZString PTR, BYVAL b AS ZString PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_String CDECL (BYVAL a AS String PTR, BYVAL b AS String PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_WString CDECL (BYVAL a AS WString PTR, BYVAL b AS WString PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UString CDECL (BYVAL a AS UString PTR, BYVAL b AS UString PTR) AS LONG
  AC_SORT(a, b)
end function

#ifdef AFX                                            'include José´s "CBstr" if WinFBX is present
PRIVATE FUNCTION AC_CBstr CDECL (BYVAL a AS CBstr PTR, BYVAL b AS CBstr PTR) AS LONG
  AC_SORT(a, b)
end function
#endif


#macro DC_SORT(a, b)
  if *a < *b then
    return 1
  elseif *a > *b then
    return -1
  else
    return 0
  end if 
#endmacro


PRIVATE FUNCTION DC_Byte CDECL (BYVAL a AS Byte PTR, BYVAL b AS Byte PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UByte CDECL (BYVAL a AS uByte PTR, BYVAL b AS uByte PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Short CDECL (BYVAL a AS Short PTR, BYVAL b AS Short PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UShort CDECL (BYVAL a AS UShort PTR, BYVAL b AS UShort PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Integer CDECL (BYVAL a AS Integer PTR, BYVAL b AS Integer PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UInteger CDECL (BYVAL a AS UInteger PTR, BYVAL b AS UInteger PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Long CDECL (BYVAL a AS Long PTR, BYVAL b AS Long PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ULong CDECL (BYVAL a AS ULong PTR, BYVAL b AS ULong PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Longint CDECL (BYVAL a AS Longint PTR, BYVAL b AS Longint PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ULongint CDECL (BYVAL a AS ULongint PTR, BYVAL b AS ULongint PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Single CDECL (BYVAL a AS Single PTR, BYVAL b AS Single PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Double CDECL (BYVAL a AS Double PTR, BYVAL b AS Double PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ZString CDECL (BYVAL a AS ZString PTR, BYVAL b AS ZString PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_String CDECL (BYVAL a AS String PTR, BYVAL b AS String PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_WString CDECL (BYVAL a AS WString PTR, BYVAL b AS WString PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UString CDECL (BYVAL a AS UString PTR, BYVAL b AS UString PTR) AS LONG
  DC_SORT(a, b)
end function

#ifdef AFX                                            'include José´s "CBstr" if WinFBX is present
PRIVATE FUNCTION DC_CBstr CDECL (BYVAL a AS CBstr PTR, BYVAL b AS CBstr PTR) AS LONG
  DC_SORT(a, b)
end function
#endif


private Function arrayDescriptorGetPtrFunction (Byval p As Any Ptr) As Any Ptr    'thanks to fxm
  Return p
End function

#macro arrayDescriptorPtr(array, p)                   'thanks to fxm
  Scope
    Dim As Function (() As Typeof((array))) As Any Ptr f
    f = Cast(Function (() As Typeof((array))) As Any Ptr, @arrayDescriptorGetPtrFunction)
    p = f(array())
  End Scope
#endmacro


#define all(X) A, X, 0                                'sort the whole array or a given dimension
#define ascend AC                                     'sort ascending
#define descend DC                                    'sort descending

#define ascend_ AC, A, 1, 0                           'sort the entire 1. dimension ascending
#define descend_ DC, A, 1, 0                          'sort the entire 1. dimension descending


#macro array_Sort(x, t, D, I, C)
'***********************************************************************************************
' array_sort(array, ascend/descend/@Customsortproc, dimension, index , count)

' Sorts a one-dimensional(!) fixed-size or dynamic array calling the C qsort function.
' String sorting is case sensitive. Make it case insensitive by using a custom sort (ucase compare)

' 5 Parameters:
' - x: array variable without brackets
' - t: "ac"/"{a}s{c}end", "dc"/"{d}es{c}end" or a pointer to a custom sort function (@customsortproc)
'      "a/descend_" replaces the last 4 parameters and sorts the first dimension entirely

' Example: array_sort(myarray, ascend_)

' - d: dimension
' - i: absolute index to start at (inside dimension)
' - c: count (# of elements to sort)

' the last three argumemts may be replaced by "ALL()", "ALL(1)", "ALL(2)" ...
' where the number inside the brackets denominates the dimension to sort entirely
' "ALL()" sorts the entire array over all dimensions

' Example: array_sort(myarray, ac, 2, 3, 4): sorts 4 elements in the 2. dimension
'                                            of myarray starting at myarray(2, 3)
' Example: array_sort(myarray, ac, all(3)) : sorts the 3. dimension of myarray entirely

' Example: array_sort(myarray, ascend_)    : sorts the 1. dimension of myarray entirely ascending

' ERR = 0 for success, = 6 for invalid index or dimension values, 7 for invalid custom sort proc
' any other value = run time error 
'***********************************************************************************************
scope
dim p__t_r as any ptr
dim n__u_m as ulong = 0


  err = 0

  #if (#D = "A")                                      'all(...)
    #if (#i = "")                                     'whole array
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if z <= 0 then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if 
          next l

          n__u_m = n__u_m * z

          arrayDescriptorPtr(x, pArrayDescriptor)
          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        end if
      end scope
     
    #else                                             'dimension #i
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if (z <= 0) or (i < 1) or (i > z) then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if 
          next l

          n__u_m = n__u_m * (i-1)

          arrayDescriptorPtr(x, pArrayDescriptor)

          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
          p__t_r = p__t_r + (n__u_m * sizeof(typeof((x))))
          n__u_m = UBOUND(x, i) - LBOUND(x, i) + 1
        end if
      end scope
     
    #endif
 
  #else                                               'dimension #d, from i, for c
    scope
      dim l as long                                   'looper
      dim z as long                                   '# of dimensions available
        dim n as long                                 'max. size of dimension
      Dim As Integer Ptr pArrayDescriptor

      z = ubound(x, 0)                                '# of dimensions
      if (z <= 0) or (d < 1) or (d > z) then
        err = 6

      else
        for l = 1 to z
          n = UBOUND(x, l) - LBOUND(x, l) + 1
          if n > n__u_m then
            n__u_m = n
          end if 
        next l

        n__u_m = n__u_m * (d-1)

        arrayDescriptorPtr(x, pArrayDescriptor)
        p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        p__t_r = p__t_r + (n__u_m + i - 1) * sizeof(typeof((x)))
        n__u_m = c
      end if
    end scope
  #endif
 

  #if (#t = "ac") or (#t = "Ac") or (#t = "AC") or (#t = "aC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #elseif (#t = "dc") or (#t = "Dc") or (#t = "DC") or (#t = "dC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #else
    if t <> 0 then                                    'prevent null pointer
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), cast(any ptr, t)

    else
      err = 7
    end if 
  #endif
end scope
#endmacro


'***********************************************************************************************


#macro array_insert(a, i, v)                          'array, (absolute) index , value
'***********************************************************************************************
' Inserts a new element at the specified index of a dynamic array and assigns a value to it
' this macro fails for fixed-size arrays (cannot be redimed!)

' 3 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array where the new element will be added.
' - v: value of the new element.
'      this may be a variable of the same type or constant where applicable
'      for UDTs not supporting the "=" operator, you must pass a variable of
'      the same type, initialzed to whatever is needed

' ERR is set to 0 for success, to 99 for fixed-size array, 6 = invalid index
' any other value = run time error 
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  IF (i >= l__b) and (i <= u__b + 1) THEN             'a valid index
    scope
      REDIM PRESERVE a(l__b TO u__b + 1)
    END scope                                         'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

    IF UBOUND(a) = u__b + 1 THEN                      'success
      FOR z AS LONG = UBOUND(a) TO i + 1 STEP - 1     'move elements up, last one first
         a(z) = a(z - 1)
      NEXT

      a(i) = v                                        'assign value to new element

    else
      err = 99                                        'return fail (fixed-size array)
    end if

  else
    err = 6                                           'index out of bounds
  end if 
END scope
#endmacro


'***********************************************************************************************


#macro array_delete(a, i)                             'array, (absolute) index
'***********************************************************************************************
' Deletes the element at the specified index of a dynamic array by shifting down all
' following elements, this function works for fixed-size arrays too
' Please note: in case of a fixed-size array the last element will still be present
' (cannot be redimed!) but it will be reinitialzed to it´s default state

' 2 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array which will be deleted

' ERR is set to 0 for success, to 99 for fixed-size array, any other value = run time error 
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  scope
    IF (i >= l__b) and (i <= u__b + 1) THEN           'a valid index
      FOR z AS LONG = i to u__b - 1                   'move items down
         a(z) = a(z + 1)
      NEXT

      REDIM PRESERVE a(l__b TO u__b - 1)              'try to remove the last element

    else
      u__b += 1                                       'make ubound(a) <> u__b !
    end if 
  END scope                                           'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

  IF UBOUND(a) = u__b THEN                            'a fixed-size array
    dim x as typeof(a)
    a(ubound(a)) = x                                  'reinitialize the variable, because it wasn´t deleted

    err = 99                                          'was a fixed-size array
  end if

end scope
#endmacro


'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************


Currently you must remove or outcomment all the "USTRING" stuff, because this isn´t implemented in the compiler yet. In order to get a pointer to the first element of a multidimensional array i make use of the array descriptor, which is by far the fastest way. Otherwise i would have to iterate through dimensions and get the correct LBOUND for each dimension, which finally let´s me retrieve a pointer to the first element (@array(lbound of dimension 1 [, lbound of dimersion 2, ...])). This pointer is available for fixed size arrays too.

The code might be optimized by making direct use of more elements of the descriptor, but i´m not sure, if all elements are available for fixed size arrays under all circumstances. I will have to run more tests for this.

I have ideas for the search or scan feature, but depending on how exactly this will implemented (see above 1,2,3) i will have to write FB or C code, therefore i didn´t code anything so far.

To answer your question: I don´t want to modify the array descriptor, but i want to make use of it, i.e. read it´s content for manipulating the array itself.

How do you like these new array features? Are they useful? Are the macros user friendly and straightforeward or do you see problems? Can you find bugs, i missed? What else should be added?


JK
Tourist Trap
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: New array features

Postby Tourist Trap » May 14, 2019 3:01

Hello,

is there a cost in term of performance with the improved handling?
Otherwise, in my opinion, we should have a simple unhandled version (fast), and a new handled stuff, handled but slower. If of course there is performance cost. I don't know.

Thanks anyway for those proposals. Need time to test, but looks rich.
paul doe
Posts: 919
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: New array features

Postby paul doe » May 14, 2019 3:26

Juergen Kuehlwein wrote:...
Before making a new pull request i would like to know, what would be the preferred/best way of implementing the new array features (sort, insert, delete). I see three ways to go:

1.) as is - add it as include file (definitions and run time code in array.bi). The features are available only, if array.bi is included. This makes everything acessible to the user.

2.) add only the definitions to array.bi, and add the code to the runtime library, which still requires array.bi to be included for making the features available (just like file.bi). This keeps parts of the low level stuff away from the user

3.) add it to the compiler (new keywords etc.) and add the actual code to the runtime library, which makes an include file (array.bi) obsolete. This keeps all the low level stuff away from the user
...

1 is the easier way, 2 is a little more upfront work but a more sensible choice; 3 is out of question, I think. While you're at it, would you also consider other useful features such as map/reduce, and set operations (intersections, joins and the like)?

Juergen Kuehlwein wrote:...
To answer your question: I don´t want to modify the array descriptor, but i want to make use of it, i.e. read it´s content for manipulating the array itself.
...

I've always thought that BASIC dialects in general abstract too much from the user (the other extreme would be Forth-like dialects; they don't abstract anything from you). One useful middle ground (and also useful for others that might want to code additional features) would be to expose a small API that deal with compiler internals (which can be implemented like option 2 above).

Nice to see that Jeff and you are working on developments for the compiler. Your efforts are much appreciated, guys.
fxm
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 14, 2019 8:05

Have you tested your macro 'array_Sort ()'?
There are several similar blocks that I do not understand, for example this (see the question marks):

Code: Select all

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if
          next l

          n__u_m = n__u_m * (i-1)                                  '' ?????

          arrayDescriptorPtr(x, pArrayDescriptor)

          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
          p__t_r = p__t_r + (n__u_m * sizeof(typeof((x))))         '' ?????
          n__u_m = UBOUND(x, i) - LBOUND(x, i) + 1
        end if
fxm
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 14, 2019 8:48

For the macro 'array_delete()', if the passed array has a single element, the array must be erased ('REDIM PRESERVE a(l__b TO u__b - 1)' crashes if l__b = u__b):

Code: Select all

  scope
    IF (i >= l__b) and (i <= u__b + 1) THEN           'a valid index
      FOR z AS LONG = i to u__b - 1                   'move items down
         a(z) = a(z + 1)
      NEXT

      IF (l__b = u__b) THEN
        ERASE a
      ELSE
        REDIM PRESERVE a(l__b TO u__b - 1)              'try to remove the last element
      END IF

    else
      u__b += 1                                       'make ubound(a) <> u__b !
    end if
  END scope                                           'this scope is necessary for correct results of ubound(a)
Remark: This [Scope...End Scope] block is useless for me.
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: New array features

Postby Lost Zergling » May 14, 2019 9:07

@Juergen Kuehlwein : "The more a fast searching function scanning the whole array (or parts of it) for a value would be of help."
I am not convinced of the interest of a search function of keywords in a table, except for low to medium volumetrics and for not too dynamic operations. Indeed, it implies to consider the structure of the table, so to index it. This raises the question of maintaining the index as the table changes and the impact on the memory reallocation needs. I will join Paul Doe a little on the issues of map / reduce, and set operations (intersections, join and like). I think we could find examples in the forum of table management at the experimental stage. Such an extension would be complementary to the lists (more suited to non sql tasks). I shall remember fast sgbdr operations using arrays were based on matrix calculus and not just string management so it should be possible to retrieve a state of the art in the matter on the net. On the other hand, the technical level is very specific.
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: New array features

Postby dodicat » May 14, 2019 10:56

You can of course use memcpy for these arrayinsert/delete macros, (done about a dozen times before), but I think the ordinary looping is probably best.
Anyway, another comparison of the C quicksort and the bog standard quicksort.
I would say the C quicksort could be the pink for general use (because it is more or less built in), looking at -gen gas, optimised and not optimised 32/64 bits. But it is a close call.

Code: Select all

 


#include once "crt.bi"

'=========  set up c sort =========
#define up <,>
#define down >,<
#define ArrayToSort(x,start,finish) @X((start)),((finish)-(start)+1),Sizeof(X)
#macro SetCSort(Datatype,FnName,b1,b2,dot)
Function FnName Cdecl(n1 As Any Ptr,n2 As Any Ptr) As long
    If *Cptr(Datatype Ptr,n1)dot b1 *Cptr(Datatype Ptr,n2)dot Then Return -1
    If *Cptr(DataType Ptr,n1)dot b2 *Cptr(DataType Ptr,n2)dot Then Return 1
    return 0
End Function
#endmacro

'=========  set up quicksort sort =========
 
#macro SetQsort(datatype,fname,b1,b2,dot)
    Sub fname(array() As datatype,begin As Long,Finish As long)
    Dim As Long i=begin,j=finish
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
        While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J > begin Then fname(array(),begin,J)
    If I < Finish Then fname(array(),I,Finish)
    End Sub
#endmacro 

#macro setarray(array,what)
randomize 1
for n as long=lbound(array) to ubound(array)
    array(n)=what
next n
#endmacro

#macro Showafew(array,msg,dot)
print msg
for n as long=lbound(array) to 5
    print array(n)dot
next
print ". . ."
for n as long=ubound(array) -5 to ubound(array)
    print array(n)dot
next
print"_______________"
print
#endmacro

dim as double t  'timer

redim as double d(1000000)
setCsort(double,callbackdouble,up,)
setQsort(double,quicksort,up,)

setarray(d,rnd-rnd)

t=timer
qsort(arraytosort(d,lbound(d),ubound(d)),@callbackdouble)
print "Time taken  "; timer-t
showafew(d,"C sort double",)

setarray(d,rnd-rnd) 'reset
t=timer
quicksort(d(),lbound(d),ubound(d))
print "Time taken "; timer-t
showafew(d,"Quicksort double",)


redim as string g(1000000)
setCsort(string,callbackstring,up,)
setQsort(string,quicksortstring,up,)


setarray(g,(str(ubound(g)-n)+" Hello"))

t=timer
qsort(arraytosort(g,lbound(g)+1,ubound(g)-2),@callbackstring)
print "Time taken  "; timer-t
showafew(g,"C sort string",)

setarray(g,(str(ubound(g)-n)+" Hello"))
t=timer
quicksortstring(g(),lbound(g)+1,ubound(g)-2)
print "Time taken "; timer-t
showafew(g,"Quicksort string",)
print

type vector
    as integer x,y,z
end type

redim as vector v(1000000)
setCsort(vector,callbackvector,up,.z)
setQsort(vector,quicksortvector,up,.z)


setarray(v,type(rnd*1000000,rnd*1000000,rnd*1000000))

t=timer
qsort(arraytosort(v,lbound(v),ubound(v)),@callbackvector)
print "Time taken  "; timer-t
showafew(v,"C sort integer vector z component",.z)

setarray(v,type(rnd*1000000,rnd*1000000,rnd*1000000))
t=timer
quicksortvector(v(),lbound(v),ubound(v))
print "Time taken "; timer-t
showafew(v,"Quicksort integer vector z component",.z)
print
print "Done"
sleep


 
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: New array features

Postby Lost Zergling » May 14, 2019 11:33

I remember a web article that explained a practical way by simple schemas & exemples the algorithm & method to implement to optimize search in a table using vectors on matrix, without having to stuff (too much) the theoretical maths, so I did a quick search, impossible to find it neither something approaching. Mainly found useless stuff, not "how to make".
fxm
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 14, 2019 13:38

dodicat wrote:You can of course use memcpy for these arrayinsert/delete macros, (done about a dozen times before)

Yes, but it's easy only for simple numeric element arrays.
Otherwise, to be compatible with complex objects (with destructor) for the delete macro for example, the element to be deleted must not be overwritten by its next one, but be re-positioned (shallow copy) in the last position (instead of the previous last element), for 'Redim' to destroy it properly (and not the previous last element because duplicated).

Very simple example of delete macro without any coherence test of passed parameters:

- Bad code:

Code: Select all

#include "crt/string.bi"
#macro elementDelete(array, index)
  scope
    memcpy(@array(index), @array(index+1), (ubound(array) - index) * sizeof(array(index)))
    redim preserve array(lbound(array) to ubound(array) - 1)
  end scope
#endmacro

Redim As String s(1 to 9)
For I As Integer = Lbound(s) to Ubound(s)
  s(I) = Str(I)
Next I

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

elementDelete(s, 5)

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

Sleep

Code: Select all

1   2   3   4   5   6   7   8   9
1   2   3   4   6   7   8   -

- Proper code:

Code: Select all

#include "crt/string.bi"
#macro elementDelete(array, index)
  scope
    dim as any ptr p = allocate(sizeof(array(index)))
    memcpy(p, @array(index), sizeof(array(index)))  '' shallow copy of array(index) to allocated memory
    memcpy(@array(index), @array(index+1), (ubound(array) - index) * sizeof(array(index)))
    memcpy(@array(ubound(array)), p, sizeof(array(index)))  '' shallow copy of allocated memory to array(ubound(array))
    deallocate(p)
    redim preserve array(lbound(array) to ubound(array) - 1)
  end scope
#endmacro

Redim As String s(1 to 9)
For I As Integer = Lbound(s) to Ubound(s)
  s(I) = Str(I)
Next I

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

elementDelete(s, 5)

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

Sleep

Code: Select all

1   2   3   4   5   6   7   8   9
1   2   3   4   6   7   8   9


Similar problem for the insert macro (without any coherence test of passed parameters):

- Bad code:

Code: Select all

#include "crt/string.bi"
#macro elementInsert(array, index, element)
  scope
    redim preserve array(lbound(array) to ubound(array) + 1)
    memcpy(@array(index + 1), @array(index), (ubound(array) - index) * sizeof(array(index)))
    array(index) = element
  end scope
#endmacro

Redim As String s(1 to 9)
For I As Integer = Lbound(s) to Ubound(s)
  s(I) = Str(I)
Next I

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

elementInsert(s, 5, "10")

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

Sleep

Code: Select all

1   2   3   4   5   6   7   8   9
1   2   3   4   10   1   6   7   8   9

- Proper code:

Code: Select all

#include "crt/string.bi"
#macro elementInsert(array, index, element)
  scope
    redim preserve array(lbound(array) to ubound(array) + 1)
    dim as any ptr p = allocate(sizeof(array(index)))
    memcpy(p, @array(ubound(array)), sizeof(array(index)))  '' shallow copy of array(ubound(array)) to allocated memory
    memcpy(@array(index + 1), @array(index), (ubound(array) - index) * sizeof(array(index)))
    memcpy(@array(index), p, sizeof(array(index)))  '' shallow copy of allocated memory to array(index)
    deallocate(p)
    array(index) = element  '' deep copy of element to array(index)
  end scope
#endmacro

Redim As String s(1 to 9)
For I As Integer = Lbound(s) to Ubound(s)
  s(I) = Str(I)
Next I

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

elementInsert(s, 5, "10")

For I As Integer = Lbound(s) to Ubound(s)
  Print s(I) & "   ";
Next I
Print

Sleep

Code: Select all

1   2   3   4   5   6   7   8   9
1   2   3   4   10   5   6   7   8   9
Last edited by fxm on May 14, 2019 18:57, edited 1 time in total.
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 14, 2019 17:03

A lot of posts - great! So there seems to be some interest in this topic. Before going into details can we agree, that having generic functions, macros or statements for sorting/inserting into/deleting from/scanning an array would be a useful feature?

@dodicat

could be the pink for general use
I don´t know this phrase, but i think you agree, that qsort is a correct choice


@all

As said above the posted code isn´t optimized in any way. See it as a first attempt as a proposal, how to solve it. I decided to use macros , because macros allow for more flexibility with parameters. I can use key-words ("all", ascend", etc.), which i can´t when using a function.

Thinking about it, i could remove the redim parts from array_insert and array_delete and leave that to the user. So that in fact only shifting of array elements is taking place. In case of array_insert the topmost element would be shifted out (deleted), if the array isn´t big enough. But this way i could implement it not only for the first dimension and i avoid the problem of static arrays not really being resizeable (it would take the onus on the user to care for this).

Yes, memcpy would make things faster, but in case of complex types with a destructor, you must take care, that an element, which is permanently removed by overwriting it, gets deleted properly. Otherwise we would have memory leaks. In case of an insert operation, the inserted element would have to be initialized (call default constructior). One possible way for handling this, could be to care for the element to be deleted or inserted separately and move the rest with memcpy, just like fxm demonstrated.


JK
Iczer
Posts: 49
Joined: Jul 04, 2017 18:09

Re: New array features

Postby Iczer » May 14, 2019 21:27

Maybe Associative array would be great addition

and also, to make array-functions list more complete, i think would be interesting to have (mostly for 1d arrays):
Array Search (any good algorithms)
Array FindAll (Find the indices of all occurrences of a search query between two points in a 1D or 2D array )
Array Combinations
Array Concatenate(Concatenate two arrays )
Array Permute (Returns an array of the Permutations of all Elements)
Array Pop (Returns the last element of an array, deleting that element from the array at the same time)
Array Push (Add new values without increasing array size by inserting at the end the new value and deleting the first one or vice versa)
Array Reverse (reverses the order in which the elements appear)
Array Unique (remove all duplicates)
Array Transpose (swaps rows and columns in 2d array)
Array Max (Returns the highest value (or index of value) held in array)
Array Min (Returns the lowest value (or index of value) held in array)
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: New array features

Postby Lost Zergling » May 15, 2019 0:26

The array type has the advantage of proposing a fast and comprehensible structure of the information filling relatively little space in memory and which can serve as a technical basis for the matrix calculation and many others (statistics, R language). In addition, the speed is very fast because the data is usually organized contiguously. There is a possible assimilation with the matrix or with the tables which are conceptual types of high level whereas the arrays are of types low level. In my algorithms, I often use low-level arrays as parameterized filters in combination with lists and these small arrays (low level) are for me essential because of the huge impact on speed (compared to lists).
The question is therefore to bring the array to a higher level of conceptual abstraction. This could be considered at the level of the characteristics type DBMS (sorting / inserting into / deleting from / scanning), scientific (matrix) or even statistics (calculations). Then the question arises of how without losing the performance "low level" intrinsic ? over implementation could be a hint.
The user who requests a "high level" function has nothing to do with the memory consumption and is ready to accept a small processing time, but he can not give up the functional aspect : the transparent manipulation of a table.
The programmer, in some cases, will prefer to build indexes and manipulate lists, so it would be justified in this case that the preference of the user for the functional query of manipulation of the data via an array has a cost. In the case of the relevance of an underlying index, the marginal cost in time of the functional interface will be negligible compared to the cost of no index, especially on repetitive operations.
After thinking to it, I would propose the idea of using two types of algorithmic options for sorting and searching values: non-indexed (sequential run of the table) and indexed. Memory is limited, over a certain volumetry, the user must make a choice between volumetry and processing time. But this is conceivable. LZLE might be well suited as a background technical brick usage for indexed feature management (the lesser as prototyping). Regarding technical evolution of the array type for FB it might be possible (for community) to design afterwards a set of instructions far beyond the initial low level features.
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 15, 2019 17:03

@all,

thanks for your valuable input so far - keep on posting.

@fxm,

i know i owe you some answers, but work is killing me today and maybe tomorrow too, so this will have to wait a bit ...


JK

Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 33 guests