A macro to send a dynamic array as {a, b, c..} to a function

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

A macro to send a dynamic array as {a, b, c..} to a function

Postby Tourist Trap » Oct 27, 2016 8:40

Not too much time those days so I post this here just to illustrate the variadic parameters feature of the macros.

Code: Select all

'a macro that takes as entry:                                             
'   * a array processing function name, say F( A() as datatype)           
'   * the datatype of the array (1D array)                               
'   * a variadic list of items (of the datatype) in curled braces notation
'then,                                                                   
'sends the variadic list as an array to the function                     
'                                                                         
'syntax:                                                                 
'MACRONAME(F, single, { 1, 2, 3 } )                                       
'                                                                         
'note that this seems not possible to write F( {1, 2, 3} ) in FB otherwise


sub ArrayProcess( ArrayParameter() as single )
    print "ProcessArray function call"
    print "Array received length: "; uBound( ArrayParameter ) + 1
    print "Array content:"
    for index as integer = 0 to uBound(ArrayParameter)
        ? ArrayParameter(index)
    next index
end sub

#define _CARSTR(a, b...) #a
#define _CDRSTR(a, b...) #b
#macro _SENDDATATOARRAYPROCESSOR(arrayProcessorName, arrayDataType, item0, items...)
    scope
        'prepare a void array of the required datatype
        dim as arrayDataType    array(any)
        'make the initial list content a string
        dim as string listContent => _
        trim(rtrim( " "& rtrim(ltrim(_CARSTR(item0, items), "{"), "}") &", "& _
                    rtrim( _CDRSTR(item0, items), "}" ) _
             , any " " ), _
             "," )
        do
            'parse the list and feed the array
            dim as string tempItem
            if instr(listContent, ",")>0 then
                tempItem = left(listContent, instr(listContent, ",") - 1)
            else
                tempItem = listContent
            end if
            'the following if-block should be treated depending on the datatype
            'here a void char in the list will be ignored as an item for the array
            if trim(tempItem, any space(1))<>"" then
                redim preserve array(uBound(array) + 1)
                'the following instruction should offer one case by datatype
                select case trim(lCase(#arrayDataType), any space(1))
                    case "single"
                        array(uBound(array)) = cSng(tempItem)
                end select
            end if
            listContent = right(listContent, len(listContent) - len(tempItem) - 1)
        loop until listContent=""
        'send data list as array to processor function
        arrayProcessorName( array() )
    end scope
#endMacro


_SENDDATATOARRAYPROCESSOR(ArrayProcess, single, { 1, 2, 3 } )


getKey()
'(eof)
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby Tourist Trap » Nov 07, 2016 4:41

Just as previously, but in a more trendy way. Should maybe require even more generalization but macros become tricky at a given point.


Code: Select all

 'calls a function taking an array as argument, F(A)                   
'by the intermediary of a macro which can                             
'declare and initialize a dynamic array in the style of a static array
'the macro is called with the syntax _F( {a, b, c}% )                 
'the type of the array data is handled via a classical literal suffix


function F overload( ArrayParameter() as integer ) as integer
    print "ProcessArray function call"
    print "Array received length: "; uBound( ArrayParameter ) + 1
    print "Array content:"
    for index as integer = 0 to uBound(ArrayParameter)
        ? ArrayParameter(index)
    next index
   '---->
   return uBound( ArrayParameter ) + 1
end function
function F overload( ArrayParameter() as single ) as integer
    print "ProcessArray function call"
    print "Array received length: "; uBound( ArrayParameter ) + 1
    print "Array content:"
    for index as integer = 0 to uBound(ArrayParameter)
        ? ArrayParameter(index)
    next index
   '---->
   return uBound( ArrayParameter ) + 1
end function
function F overload( ArrayParameter() as double ) as integer
    print "ProcessArray function call"
    print "Array received length: "; uBound( ArrayParameter ) + 1
    print "Array content:"
    for index as integer = 0 to uBound(ArrayParameter)
        ? ArrayParameter(index)
    next index
   '---->
   return uBound( ArrayParameter ) + 1
end function
function F overload( ArrayParameter() as string ) as integer
    print "ProcessArray function call"
    print "Array received length: "; uBound( ArrayParameter ) + 1
    print "Array content:"
    for index as integer = 0 to uBound(ArrayParameter)
        ? ArrayParameter(index)
    next index
   '---->
   return uBound( ArrayParameter ) + 1
end function


type VARIABLETYPEARRAYCONTAINER
   declare constructor()
   declare property ArrayDataType() as string
   declare property ArrayDataType(byref as string)
   declare sub ArrayInitialize()
      as string   _arrayDataType
      as integer   _integerArray(any)
      as single   _singleArray(any)
      as double   _doubleArray(any)
      as string   _stringArray(any)
end type
constructor VARIABLETYPEARRAYCONTAINER()
   THIS._arrayDataType   => "string"
end constructor
property VARIABLETYPEARRAYCONTAINER.ArrayDataType() as string
   '---->
   return THIS._arrayDataType
end property
property VARIABLETYPEARRAYCONTAINER.ArrayDataType(byref SetValue as string)
   THIS._arrayDataType = SetValue
end property
sub VARIABLETYPEARRAYCONTAINER.ArrayInitialize()
   select case THIS._arrayDataType
      case "integer"
         erase THIS._integerArray
      case "single"
         erase THIS._singleArray
      case "double"
         erase THIS._doubleArray
      case else
         erase THIS._stringArray
   end select
end sub


#macro _VARIADICTOSTRING( item0, items... )
   ( #item0 &", "& #items )
#endMacro

#macro _F( item0, items... )
/'please remove this line'/ color 7, 6
   scope
      dim as string   variadicToString => _VARIADICTOSTRING(item0, items)
      dim as string   spaceTrimmedVariadicToString => _
                              trim(variadicToString, any space(1))
      scope
         dim as string   innerSpaceRemovingString
         dim as integer   charPosition => 1
         while charPosition<=len(spaceTrimmedVariadicToString)
            if chr(spaceTrimmedVariadicToString[charPosition])=space(1) then
               innerSpaceRemovingString = _
                  left(spaceTrimmedVariadicToString, charPosition) & _
                  right(spaceTrimmedVariadicToString, _
                       len(spaceTrimmedVariadicToString) - charPosition - 1 _
                      )
               spaceTrimmedVariadicToString = innerSpaceRemovingString
            else
               charPosition += 1
            end if
         wend
      end scope
        'this macro won't take for an item anything outside of the bracketted bubble:
        'starting from the 1st opening curl-bracket and ending at the 1st closing one
        'in another hand, no opening or closing bracket at all wont trigger any error
        'however, some additional information will be searched outside of this bubble
        dim as integer   firstOpeningCurlBracketPosition => inStr(variadicToString, "{")
        dim as integer   firstClosingCurlBracketPosition => inStr(variadicToString, "}")
        dim as integer   firstOpeningCurlBracketPositionInSpaceTrimmedVersion => _
                                      inStr(spaceTrimmedVariadicToString, "{")
        dim as integer   firstClosingCurlBracketPositionInSpaceTrimmedVersion => _
                                      inStr(spaceTrimmedVariadicToString, "}")
       dim as string   listContentString => mid(variadicToString, _
                                      firstOpeningCurlBracketPosition, _
                                      firstClosingCurlBracketPosition - firstOpeningCurlBracketPosition)
       listContentString = lTrim(listContentString, "{")
       listContentString = rTrim(listContentString, "{")
        'grab, if any, the "static" or "dynamic" array declaration specifier, syntax:
        'sta{...}
        'dyn{...}
        'this information only serves if the function called takes any account of it
      dim as boolean   isStaticArray => FALSE
        if firstOpeningCurlBracketPositionInSpaceTrimmedVersion>3 then
           if lCase(mid(spaceTrimmedVariadicToString, _
                     firstOpeningCurlBracketPositionInSpaceTrimmedVersion - 3, _
                     3 _
                    ) _
                 )="sta" then
              isStaticArray = TRUE
           else
              isStaticArray = FALSE
           end if
        end if
        'grab, if any, the type specifier - if no specifier, considers a string array
        'syntax:
        '{...}%
        '{...}!
        '{...}#
        'anything else taken as string array
        dim as string   arrayDataType => "string"
        if firstClosingCurlBracketPositionInSpaceTrimmedVersion< _
                                (len(spaceTrimmedVariadicToString)) then
           dim as string typeSpecifierCharHolder => _
         mid(spaceTrimmedVariadicToString, firstClosingCurlBracketPositionInSpaceTrimmedVersion + 1, 1)
         select case typeSpecifierCharHolder
            case "%"
               arrayDataType = "integer"
            case "!"
               arrayDataType = "single"
            case "#"
               arrayDataType = "double"
            case else
               
         end select
        end if
        'parse the list and feed the array of the proper datatype
        dim as VARIABLETYPEARRAYCONTAINER   vtac
        vtac.ArrayDataType => arrayDataType
        vtac.ArrayInitialize()
/'please remove this line'/ ? listContentString
/'please remove this line'/ ? iif(isStaticArray, "sta", "dyn")
/'please remove this line'/ ? arrayDataType
        do
            dim as string   tempItem
            if instr(listContentString, ",")>0 then
                tempItem = left(listContentString, instr(listContentString, ",") - 1)
            else
                tempItem = listContentString
            end if
            'a void char in the list will be ignored as an item for the array
            if trim(tempItem, any space(1))<>"" then
                'the following instruction has one case by possible datatype
              select case arrayDataType
                 case "integer"
                    redim preserve   vtac._integerArray(uBound(vtac._integerArray) + 1)
                    vtac._integerArray(uBound(vtac._integerArray)) = cInt(tempItem)
                 case "single"
                    redim preserve   vtac._singleArray(uBound(vtac._singleArray) + 1)
                    vtac._singleArray(uBound(vtac._singleArray)) = cSng(tempItem)
                 case "double"
                    redim preserve   vtac._doubleArray(uBound(vtac._doubleArray) + 1)
                    vtac._doubleArray(uBound(vtac._doubleArray)) = cDbl(tempItem)
                 case else
                    redim preserve   vtac._stringArray(uBound(vtac._stringArray) + 1)
                    vtac._stringArray(uBound(vtac._stringArray)) = str(tempItem)
              end select
          end if
            listContentString = right(listContentString, len(listContentString) - len(tempItem) - 1)
        loop until listContentString=""
        'send data list as the new array to the function that has to process it
/'please remove this line'/ color 14, 2
        select case arrayDataType
           case "integer"
              F( vtac._integerArray() )
           case "single"
              F( vtac._singleArray() )
           case "double"
              F( vtac._doubleArray() )
           case else
              F( vtac._stringArray() )
        end select
    '
   end scope
#endMacro


_F( { 9.999, 8.44, 7.29}% )



getKey()
'(eof)

/'
Good to know (from the FB documentation at LITERALS page):
----------------------------------------------------------
"%", are considered as signed 32/64 (depending on platform) bit integers. (Integer)           
A suffix of "!" on a number specifies a single precision (32 bit total) floating point value.
A suffix of "#" specifies a double precision float.                                           
"L", "&", are considered as signed 32 bit long integers. (Long)                               
"U", are considered as unsigned 32/64 (depending on platform) bit integers. (UInteger)       
"UL", are considered as unsigned 32 bit integers. (Ulong)                                     
"LL", are considered as signed 64 bit integers. (LongInt)                                     
"ULL", are considered as unsigned 64 bit integers. (ULongInt)                                 
'/
ganache
Posts: 38
Joined: Aug 04, 2016 9:25

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby ganache » Nov 12, 2016 10:30

This is a bit off topic.but...
If i have an unsorted array how can I print out only the unique array elements.
Say i have the elements {7,9,12,9,15,18,15,3,7} i want the output as
{12,15,18,3}
Any hints,please?
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby Tourist Trap » Nov 12, 2016 15:14

[edit] Speedy dodi has killed me ;)
Last edited by Tourist Trap on Nov 12, 2016 15:26, edited 1 time in total.
dodicat
Posts: 5755
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby dodicat » Nov 12, 2016 15:16

But 15 is not unique, you have two of them.
perhaps:

Code: Select all


#macro cleanup(InArray,OutArray)
scope
#macro check(array,n_,i_)
do
r=0
for z as long=lbound(array) to ubound(array)
   if z<>i_ then if array(z)=n_ then r=1:exit do
next z
exit do
loop
#endmacro
dim as long r,counter
for n as long=lbound(InArray) to ubound(InArray)
    check(InArray,InArray(n),n)
    if r=0 then
        counter+=1
        redim preserve OutArray(1 to counter)
        OutArray(ubound(OutArray))=InArray(n)
        end if
    next n
    end scope
#endmacro

#macro show(a)
    For n As Integer=Lbound(a) To Ubound(a)
        Print a(n);
    Next
    Print
#endmacro
'=======================  Your example ========================
dim as long L(...)= {7,9,12,9,15,18,15,3,7}
print
print "original"
show(L)
redim as long LongAnswer()
cleanup(L,LongAnswer)

print "unique"
show(LongAnswer)
'=======================  Another =============================
dim as string S(...)={"a","b","c","d","e","f","a","b","c","d","e"}
print
print
print "original"
show(S)
redim as string StringAnswer()
cleanup(S,StringAnswer)
print "unique"
show(StringAnswer)
sleep
 
integer
Posts: 378
Joined: Feb 01, 2007 16:54
Location: usa

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby integer » Nov 12, 2016 23:09

ganache wrote:This is a bit off topic.but...
If i have an unsorted array how can I print out only the unique array elements.
Say i have the elements {7,9,12,9,15,18,15,3,7} i want the output as
{12,15,18,3}
Any hints,please?

Check each element of the array against all other elements in the array:

Code: Select all

   dim as long array(1 to 12) = {7,9,12,9,15,18,15,3,7}
   dim as integer i, j, unique, elements = 9
   
   for i = 1 to elements
      unique = 1
      for j = 1 to elements
         if j = i then continue for
         if array(i) = array(j) then
            unique = 0
         end if
      next j
     
      if unique then print array(i)

   next i


If the array() is large (somewhere about 2 dozen) it would be faster to sort the array, and skip over duplicates.
Last edited by integer on Nov 14, 2016 13:47, edited 1 time in total.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

dynamic array as {a, b, c..}

Postby Tourist Trap » Nov 12, 2016 23:58

Update:
now it sorts the array with dup removed. Ok this is more a demo , but as a result the single instruction required to solve the issue is quite natural:
  •  _SORT( { 7, 9, 12, 9, 15, 18, 15, 3, 7 }# )

Code: Select all

 'solve an array sorting problem with focus on expressivity

'content:                       
'--------                       
'the curled brace manager       
'the function-like UDT that sorts
'main program                   


''_ _ _ _ _ _ _ _ _ _ ____________the curled brace manager
'''_ _ _ _ _ _ _ _ _ _ ____________________________________
type VARIABLETYPEARRAYCONTAINER
   declare constructor()
   declare property ArrayDataType() as string
   declare property ArrayDataType(byref as string)
   declare sub ArrayInitialize()
      as string   _arrayDataType
      as integer   _integerArray(any)
      as single   _singleArray(any)
      as double   _doubleArray(any)
      as string   _stringArray(any)
   #define _VARIABLETYPEARRAYCONTAINERIMPLEMENTATIONSTART
   #define _VARIABLETYPEARRAYCONTAINERIMPLEMENTATIONEND
end type
label000s: _VARIABLETYPEARRAYCONTAINERIMPLEMENTATIONSTART
constructor VARIABLETYPEARRAYCONTAINER()
   THIS._arrayDataType   => "string"
end constructor
property VARIABLETYPEARRAYCONTAINER.ArrayDataType() as string
   '---->
   return THIS._arrayDataType
end property
property VARIABLETYPEARRAYCONTAINER.ArrayDataType(byref SetValue as string)
   THIS._arrayDataType = SetValue
end property
sub VARIABLETYPEARRAYCONTAINER.ArrayInitialize()
   select case THIS._arrayDataType
      case "integer"
         erase THIS._integerArray
      case "single"
         erase THIS._singleArray
      case "double"
         erase THIS._doubleArray
      case else
         erase THIS._stringArray
   end select
end sub
label000e: _VARIABLETYPEARRAYCONTAINERIMPLEMENTATIONEND


#macro _VARIADICTOSTRING( item0, items... )
   ( #item0 &", "& #items )
#endMacro
#macro _SORT( item0, items... )
   scope
      dim as string   variadicToString => _VARIADICTOSTRING(item0, items)
      dim as string   spaceTrimmedVariadicToString => _
                              trim(variadicToString, any space(1))
      scope
         dim as string   innerSpaceRemovingString
         dim as integer   charPosition => 1
         while charPosition<=len(spaceTrimmedVariadicToString)
            if chr(spaceTrimmedVariadicToString[charPosition])=space(1) then
               innerSpaceRemovingString = _
                  left(spaceTrimmedVariadicToString, charPosition) & _
                  right(spaceTrimmedVariadicToString, _
                       len(spaceTrimmedVariadicToString) - charPosition - 1 _
                      )
               spaceTrimmedVariadicToString = innerSpaceRemovingString
            else
               charPosition += 1
            end if
         wend
      end scope
        'this macro won't take for an item anything outside of the bracketted bubble:
        'starting from the 1st opening curl-bracket and ending at the 1st closing one
        'in another hand, no opening or closing bracket at all wont trigger any error
        'however, some additional information will be searched outside of this bubble
        dim as integer   firstOpeningCurlBracketPosition => inStr(variadicToString, "{")
        dim as integer   firstClosingCurlBracketPosition => inStr(variadicToString, "}")
        dim as integer   firstOpeningCurlBracketPositionInSpaceTrimmedVersion => _
                                      inStr(spaceTrimmedVariadicToString, "{")
        dim as integer   firstClosingCurlBracketPositionInSpaceTrimmedVersion => _
                                      inStr(spaceTrimmedVariadicToString, "}")
       dim as string   listContentString => mid(variadicToString, _
                                      firstOpeningCurlBracketPosition, _
                                      firstClosingCurlBracketPosition - firstOpeningCurlBracketPosition)
       listContentString = lTrim(listContentString, "{")
       listContentString = rTrim(listContentString, "{")
        'grab, if any, the "static" or "dynamic" array declaration specifier, syntax:
        'sta{...}
        'dyn{...}
        'this information only serves if the function called takes any account of it
      dim as boolean   isStaticArray => FALSE
        if firstOpeningCurlBracketPositionInSpaceTrimmedVersion>3 then
           if lCase(mid(spaceTrimmedVariadicToString, _
                     firstOpeningCurlBracketPositionInSpaceTrimmedVersion - 3, _
                     3 _
                    ) _
                 )="sta" then
              isStaticArray = TRUE
           else
              isStaticArray = FALSE
           end if
        end if
        'grab, if any, the type specifier - if no specifier, considers a string array
        'syntax:
        '{...}%
        '{...}!
        '{...}#
        'anything else taken as string array
        dim as string   arrayDataType => "string"
        if firstClosingCurlBracketPositionInSpaceTrimmedVersion< _
                                (len(spaceTrimmedVariadicToString)) then
           dim as string typeSpecifierCharHolder => _
         mid(spaceTrimmedVariadicToString, firstClosingCurlBracketPositionInSpaceTrimmedVersion + 1, 1)
         select case typeSpecifierCharHolder
            case "%"
               arrayDataType = "integer"
            case "!"
               arrayDataType = "single"
            case "#"
               arrayDataType = "double"
            case else
               
         end select
        end if
        'parse the list and feed the array of the proper datatype
        dim as VARIABLETYPEARRAYCONTAINER   vtac
        vtac.ArrayDataType => arrayDataType
        vtac.ArrayInitialize()
        do
            dim as string   tempItem
            if instr(listContentString, ",")>0 then
                tempItem = left(listContentString, instr(listContentString, ",") - 1)
            else
                tempItem = listContentString
            end if
            'a void char in the list will be ignored as an item for the array
            if trim(tempItem, any space(1))<>"" then
                'the following instruction has one case by possible datatype
              select case arrayDataType
                 case "integer"
                    redim preserve   vtac._integerArray(uBound(vtac._integerArray) + 1)
                    vtac._integerArray(uBound(vtac._integerArray)) = cInt(tempItem)
                 case "single"
                    redim preserve   vtac._singleArray(uBound(vtac._singleArray) + 1)
                    vtac._singleArray(uBound(vtac._singleArray)) = cSng(tempItem)
                 case "double"
                    redim preserve   vtac._doubleArray(uBound(vtac._doubleArray) + 1)
                    vtac._doubleArray(uBound(vtac._doubleArray)) = cDbl(tempItem)
                 case else
                    redim preserve   vtac._stringArray(uBound(vtac._stringArray) + 1)
                    vtac._stringArray(uBound(vtac._stringArray)) = str(tempItem)
              end select
          end if
            listContentString = right(listContentString, len(listContentString) - len(tempItem) - 1)
        loop until listContentString=""
        'send data list as the new array to the function that has to process it
        select case arrayDataType
           case "integer"
              dim as SUDARRAY      sudar2 => SUDARRAY( vtac._doubleArray() )
           case "single"
              dim as SUDARRAY      sudar2 => SUDARRAY( vtac._doubleArray() )
           case "double"
              dim as SUDARRAY      sudar2 => SUDARRAY( vtac._doubleArray() )
           case else
              dim as SUDARRAY      sudar2 => SUDARRAY( vtac._doubleArray() )
        end select
    '
   end scope
#endMacro


''_ _ _ _ _ _ _ _ _ _ ____the function-like UDT that sorts
'''_ _ _ _ _ _ _ _ _ _ ____________________________________
#define _
_ARRAYLOOPOVERSTART(arrayname, indexname)   for indexname as integer = lBound(arrayname) to uBound(arrayname)
#define _
_ARRAYLOOPOVEREND(indexname)            next indexname

type SORTUNDUPDBLARRAY
   enum _RANDOMIZEDCONSTRUCTION
      _random
      _notRand
   end enum
   declare constructor(byval RCstatus as _RANDOMIZEDCONSTRUCTION=_RANDOMIZEDCONSTRUCTION._notRand)
   declare constructor( ArrayEntry() as double )
   declare property ArrayItemCount() as integer
   declare property FindDuplicateDuration()   as double
   declare property FindDuplicateDurationE3()   as integer
   declare property FindDuplicateDurationE6()   as integer
   declare property CountDuplicateDuration()   as double
   declare property CountDuplicateDurationE3()   as integer
   declare property CountDuplicateDurationE6()   as integer
   declare property SortingDuration()      as double
   declare property SortingDurationE3()   as integer
   declare property SortingDurationE6()   as integer
   #define   _TIMERETURNTYPE   double
   declare function FindDuplicate()   as _TIMERETURNTYPE
   declare function CountDuplicate()   as _TIMERETURNTYPE
   declare function SortArray()      as _TIMERETURNTYPE
   #undef   _TIMERETURNTYPE
   declare sub PrintArray(byref ArrayID as string="A")
   private:
      as double      _array(any)
      as integer      _arrayItemCount
      as double      _duplicateArray(any)
      as integer      _duplicateCountAtIndex(any)
      as integer      _duplicateTotalCount
      as double      _lastDupFindingDuration
      as double      _lastDupCountingDuration
      as double      _lastSortDuration
   #define _SORTUNDUPDBLARRAYIMPLEMENTATIONSTART
   #define _SORTUNDUPDBLARRAYIMPLEMENTATIONEND
end type
type SUDARRAY as      SORTUNDUPDBLARRAY
type _SUDARNDCONS as   SORTUNDUPDBLARRAY._RANDOMIZEDCONSTRUCTION
label001s: _SORTUNDUPDBLARRAYIMPLEMENTATIONSTART
constructor SUDARRAY(byval RCstatus as _SUDARNDCONS=_SUDARNDCONS._notRand)
   if RCstatus=_SUDARNDCONS._random then
      'make a random array with duplicates inside
      var   singleItemCount            => 4
      var minimumDuplicateCount      => 3
      var maximumDuplicateRepetition   => 3
      redim THIS._array(   singleItemCount + _
                     minimumDuplicateCount*maximumDuplicateRepetition _
                     )
      '(fb feature request) if not RANDOMIZE_TRIGGERED_BEFORE then _
                                       randomize TIMER
      _ARRAYLOOPOVERSTART(THIS._array, index)
         THIS._array(index) = _
         (1000*( log(rnd*index + 1) - int(log(index + 1)) ))  mod 100 + _
         int(10*rnd(10)*rnd*(index + 10))
      _ARRAYLOOPOVEREND(index)
   end if
   '
   ? "- - random array constructed as R"
      THIS.PrintArray("R")
   ? "- - array sorted and stored as S"
      THIS.SortArray()
      THIS.PrintArray("S")
   ?
   ? "- - find duplicate duration fd = ",      THIS.FindDuplicateDurationE6
   ? "- - remove duplicate duration rd = ",   THIS.CountDuplicateDurationE6
   ? "- - sorting duration sd = ",,         THIS.SortingDurationE6
   ?
end constructor
constructor SUDARRAY( ArrayEntry() as double )
   if lBound(ArrayEntry)<=uBound(ArrayEntry) then
      redim THIS._array(uBound(ArrayEntry) - lBound(ArrayEntry))
      '
      _ARRAYLOOPOVERSTART(THIS._array, index)
         THIS._array(index) = ArrayEntry(index)
      _ARRAYLOOPOVEREND(index)
      '
      ? "user array constructed as R"
         THIS.PrintArray("R")
      ? "array sorted and stored as S"
         THIS.SortArray()
         THIS.PrintArray("S")
   end if
   ?
   ? "- - find duplicate duration fd = ",      THIS.FindDuplicateDurationE6
   ? "- - remove duplicate duration rd = ",   THIS.CountDuplicateDurationE6
   ? "- - sorting duration sd = ",,         THIS.SortingDurationE6
   ?
end constructor
property SUDARRAY.ArrayItemCount() as integer
   THIS._arrayItemCount = uBound(THIS._array) - lBound(_array) + 1
   '---->
   return THIS._arrayItemCount
end property
property SUDARRAY.FindDuplicateDuration()   as double
   '---->
   return THIS._lastDupFindingDuration
end property
property SUDARRAY.FindDuplicateDurationE3()   as integer
   '---->
   return ( THIS._lastDupFindingDuration * 1E+3 )
end property
property SUDARRAY.FindDuplicateDurationE6()   as integer
   '---->
   return ( THIS._lastDupFindingDuration * 1E+6 )
end property
property SUDARRAY.CountDuplicateDuration()      as double
   '---->
   return THIS._lastDupCountingDuration
end property
property SUDARRAY.CountDuplicateDurationE3()   as integer
   '---->
   return ( THIS._lastDupCountingDuration * 1E+3 )
end property
property SUDARRAY.CountDuplicateDurationE6()   as integer
   '---->
   return ( THIS._lastDupCountingDuration * 1E+6 )
end property
property SUDARRAY.SortingDuration()      as double
   '---->
   return THIS._lastSortDuration
end property
property SUDARRAY.SortingDurationE3()   as integer
   '---->
   return ( THIS._lastSortDuration * 1E+3 )
end property
property SUDARRAY.SortingDurationE6()   as integer
   '---->
   return ( THIS._lastSortDuration * 1E+6 )
end property
function SUDARRAY.FindDuplicate()   as double
   var startTime   => TIMER()
   '
   #define _ARRAYINCREASE(array)   redim preserve array((uBound(array) - lBound(array)) + 1)
   #define _ARRAYLASTITEM(array)   array(uBound(array))
   '
   'algorithm inspired from integer@fb.net
   dim as double   tempArray(any)
   dim as integer   i
   dim as integer   j
   dim as integer   unicityFlag
   for i = lBound(THIS._array) to uBound(THIS._array)
       unicityFlag = 1
       for j = lBound(_array) to uBound(_array)
           if j=i then
              continue for
           end if
           if THIS._array(i)=THIS._array(j) then
              _ARRAYINCREASE(THIS._duplicateArray)
              _ARRAYLASTITEM(THIS._duplicateArray) = THIS._array(i)
              '
               unicityFlag = 0
           end if     
       next j
       if unicityFlag then
          _ARRAYINCREASE(tempArray)
          _ARRAYLASTITEM(tempArray) = THIS._array(i)
       end if
   next i
   '
   redim THIS._array(uBound(tempArray))
   _ARRAYLOOPOVERSTART(tempArray, index)
      THIS._array(index) = tempArray(lBound(tempArray) + index)
   _ARRAYLOOPOVEREND(index)
   '
   var endTime      => TIMER()
   THIS._lastDupFindingDuration   = ( endTime - startTime )
   '
   #undef   _ARRAYLASTITEM
   #undef   _ARRAYINCREASE
   '---->
   return THIS._lastDupFindingDuration
end function
function SUDARRAY.CountDuplicate()   as double
   var startTime   => TIMER()
   '
   '*TODO*'
   '
   var endTime      => TIMER()
   THIS._lastDupCountingDuration   = ( endTime - startTime )
   '
   '---->
   return THIS._lastDupCountingDuration
end function
function SUDARRAY.SortArray()      as double
   THIS.FindDuplicate()
   THIS.CountDuplicate()
   '
   var startTime   => TIMER()
   '
   do
      var hasSwaped => FALSE
      _ARRAYLOOPOVERSTART(THIS._array, index)
         if index>=uBound(THIS._array) then exit for
         '
         if THIS._array(index)>THIS._array(index + 1) then
            swap THIS._array(index), THIS._array(index + 1)
            hasSwaped = TRUE
         end if
      _ARRAYLOOPOVEREND(index)
      '
      if not hasSwaped then exit do
   loop
   '
   var endTime      => TIMER()
   THIS._lastSortDuration   = ( endTime - startTime )
   '
   '---->
   return THIS._lastSortDuration
end function
sub SUDARRAY.PrintArray(byref ArrayID as string="A")
   print ArrayID; "::{";
   _ARRAYLOOPOVERSTART(THIS._array, index)
      print THIS._array(index) & iif(index<uBound(THIS._array), " ,", "");
   _ARRAYLOOPOVEREND(index)
   print "}"
end sub
label001e: _SORTUNDUPDBLARRAYIMPLEMENTATIONEND


''_ _ _MAIN_ _ _ _ _ _______________________________
''_ _ _****_ _ _ _ _ _______________________________

   ''this is the only single instruction of the main program
   _SORT( { 7, 9, 12, 9, 15, 18, 15, 3, 7 }# )

''_ _ _****_ _ _ _ _ _______________________________
? : getKey()

'(eof)
ganache
Posts: 38
Joined: Aug 04, 2016 9:25

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby ganache » Nov 16, 2016 6:04

Thank you for the quick reply, Integer.
Program works as expected, but suppose an array does not contain any unique element(s).
I tried - if <> unique then print .. "No unique element found".- at the end (after the loop) but it does not work consistently.
Any hints?
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby Tourist Trap » Nov 16, 2016 12:54

ganache wrote:Any hints?

ganache, as you've pointed out it would be going really off topic to deal with sorting in general here. This would be better to post a question in the Programing section, at Beginner or General subsection. Sorting is a big topic, and can be very long to answer if you are totally new at it.
Here it's only about some syntactic expansion.
integer
Posts: 378
Joined: Feb 01, 2007 16:54
Location: usa

Re: A macro to send a dynamic array as {a, b, c..} to a function

Postby integer » Nov 18, 2016 1:05

ganache wrote:Thank you for the quick reply, Integer.
Program works as expected, but suppose an array does not contain any unique element(s).
I tried - if <> unique then print .. "No unique element found".- at the end (after the loop) but it does not work consistently.
Any hints?

Could you provide an example of the inconsistent results.

And TouristTrap has a good suggestion: start a new thread in the beginners section just dealing with this topic, as this is moving the focus too far from the macro/dynamic array question.
If possible provide an code snippet that does not function as wanted.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests