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:
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)