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

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

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

Post by Tourist Trap »

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: 2958
Joined: Jun 02, 2015 16:24

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

Post by Tourist Trap »

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: 47
Joined: Aug 04, 2016 9:25

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

Post by ganache »

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: 2958
Joined: Jun 02, 2015 16:24

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

Post by Tourist Trap »

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

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

Post by dodicat »

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: 408
Joined: Feb 01, 2007 16:54
Location: usa

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

Post by integer »

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: 2958
Joined: Jun 02, 2015 16:24

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

Post by Tourist Trap »

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: 47
Joined: Aug 04, 2016 9:25

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

Post by ganache »

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: 2958
Joined: Jun 02, 2015 16:24

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

Post by Tourist Trap »

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: 408
Joined: Feb 01, 2007 16:54
Location: usa

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

Post by integer »

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.
Post Reply