How Can I remove empty string In dynamic Array

General FreeBASIC programming questions.
aloberoger
Posts: 482
Joined: Jan 13, 2009 19:23

How Can I remove empty string In dynamic Array

Postby aloberoger » Jul 16, 2015 16:57

Code: Select all


dim Buffer() as string

redim Buffer(0 to 6)

For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
  end if
Next i 

 ' try to remove   Buffer(all i)="" from array
For i As Integer=0 To UBound(Buffer)
    Print "Buffer(" & i & ")= " & Buffer(i)
Next i 

Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: How Can I remove empty string In dynamic Array

Postby Tourist Trap » Jul 16, 2015 17:33

This below should work. This is the very basic solution where you read your array and copy its content to another only if it fits your condition. Then you copy back this last array (with only valid entries) to the original place that you can resize in the same time.

Code: Select all

dim  as String Buffer()
ReDim Buffer(0 to 6)
''Write some buffer with holes into
For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
  end if
Next i 

''Read buffer to substract holes entries
Dim As String TemporaryBuffer()
ReDim TemporaryBuffer(UBound(Buffer))
Dim As Integer temporaryBufferItemCounter = 0
For i As Integer=0 To UBound(Buffer)
   If Buffer(i) <> "" Then
      TemporaryBuffer(temporaryBufferItemCounter) = Buffer(i)
      temporaryBufferItemCounter += 1
   EndIf
Next i
For i As Integer=0 To temporaryBufferItemCounter
   Buffer(i) = TemporaryBuffer(i)
Next i
ReDim Preserve Buffer(0 To temporaryBufferItemCounter - 1)

''Display result
For i As Integer=0 To UBound(Buffer)
   ? Buffer(i)
Next i
Sleep

[Edit: clean up]
Last edited by Tourist Trap on Jul 17, 2015 11:29, edited 2 times in total.
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 16, 2015 18:02

Code: Select all

dim Buffer() as string

redim Buffer(0 to 6)

For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
   end if
Next i

Dim n As Integer = Lbound(Buffer)
Do While n <= Ubound(Buffer)
   If Buffer(n) = "" Then
      If Ubound(Buffer) = Lbound(Buffer) Then
         Erase Buffer
      Else
         Swap Buffer(n), Buffer(Ubound(Buffer))
         Redim Preserve Buffer(LBound(Buffer) To Ubound(Buffer) - 1)
      End If
   Else
      n += 1
   End If
Loop

For i As Integer=0 To UBound(Buffer)
    Print "Buffer(" & i & ")= " & Buffer(i)
Next i

Sleep
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 16, 2015 18:19

Version to keep the order of the not empty elements:

Code: Select all

dim Buffer() as string

redim Buffer(0 to 6)

For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
   end if
Next i

Dim n As Integer = Lbound(Buffer)
Do While n <= Ubound(Buffer)
   If Buffer(n) = "" Then
      If Ubound(Buffer) = Lbound(Buffer) Then
         Erase Buffer
      Else
         For i As Integer = n To Ubound(Buffer) - 1
            Swap Buffer(i), Buffer(i+1)
         Next i
         Redim Preserve Buffer(LBound(Buffer) To Ubound(Buffer) - 1)
      End If
   Else
      n += 1
   End If
Loop

For i As Integer=0 To UBound(Buffer)
    Print "Buffer(" & i & ")= " & Buffer(i)
Next i

Sleep

[Edit]
I prefer use:
Swap Buffer(i), Buffer(i+1)
instead of:
Buffer(i) = Buffer(i+1)
which is sufficient,
but because SWAP is optimized for the var-len strings, by exchanging only the descriptors (12 bytes) without recopying all string character data.
Last edited by fxm on Jul 16, 2015 19:22, edited 3 times in total.
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: How Can I remove empty string In dynamic Array

Postby Tourist Trap » Jul 16, 2015 18:56

Hello fxm, elegant solution.

Good to learn best practice, so I've tried to follow the swap trick, and made my own version where finally the difficult point was to count the bad items during the process -- so that we can resize the buffer accordingly at the end. I'm still not sure about this point (invalidItemCounter). However, I think this below would be readable, and it works for this example.

Code: Select all

Dim  As String Buffer()
   ReDim Buffer(0 to 6)

''Write some buffer with holes
For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
   end if
Next i 

''Display initial state
? "INITIAL"
For i As Integer=0 To UBound(Buffer)
        ? "i=";i,"Buffer("; i;")=";Buffer(i)
Next i
? "UBound(Buffer)="; UBound(Buffer)
?

''Read buffer to substract holes entries
Dim As Integer i, n, invalidItemCounter
    i = 0
    n = 1
    invalidItemCounter = 0

While i <= UBound(Buffer)
   If Buffer(0) = "" Then invalidItemCounter += 1
   If i>0 And Buffer(i-1) = "" Then invalidItemCounter += 1
   While Buffer(i)="" And i+n <= UBound(Buffer)
      Swap Buffer(i), Buffer(i+n)
      n += 1
   Wend
   n = 1
   i += 1
Wend

ReDim Preserve Buffer(UBound(Buffer) - invalidItemCounter)

''Display result
? "RESULT"
For i As Integer=0 To UBound(Buffer)
        ? "i=";i,"Buffer("; i;")=";Buffer(i)
Next i
? "UBound(Buffer)="; UBound(Buffer)

Sleep
dodicat
Posts: 6547
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How Can I remove empty string In dynamic Array

Postby dodicat » Jul 16, 2015 18:58

I have been using a simple arraydelete sub (when required) for a while.

A while ago fxm suggested a memcpy to speed things up.
But I seem to remember Win 8 and Win XP didn't agree on this, thus I use the original simple sub.
VIZ:

Code: Select all


sub arraydelete(a() as string,index as integer)
If index>=Lbound(a) And index<=Ubound(a) Then
    For x As Integer=index To Ubound(a)-1
        a(x)=a(x+1)
    Next x
    Redim Preserve a(Lbound(a) To Ubound(a)-1)
End If
end sub
'setup
redim as string s(1 to 50)

for n as integer=1 to 50
    s(n)=str(n)
next n
'make some empty
s(35)=""
s(40)=""
s(49)=""

for n as integer=lbound(s) to ubound(s)
    print n,s(n)
next n
print
print

dim as integer n
do
    n=n+1
    if s(n)="" then arraydelete(s(),n):n=n-1
    if n=ubound(s) then exit do '(the ubound changes of course)
loop

for n as integer=lbound(s) to ubound(s)
    print n,s(n)
next n
sleep
 
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 16, 2015 20:53

dodicat wrote:A while ago fxm suggested a memcpy to speed things up.
But I seem to remember Win 8 and Win XP didn't agree on this, thus I use the original simple sub.

I am not sure of that, but at least not for Win XP (that I use).
When there is overlapping between buffers, it is safer to use memmove.
Don't forget to clear the higher descriptor after the moving (and before the Redim).

So, version to test on Win 8!

Code: Select all

dim Buffer() as string

redim Buffer(0 to 6)

For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
   end if
Next i

#include "crt/string.bi"
Dim n As Integer = Lbound(Buffer)
Do While n <= Ubound(Buffer)
   If Buffer(n) = "" Then
      If Ubound(Buffer) = Lbound(Buffer) Then
         Erase Buffer
      Else
         Memmove(@Buffer(n), @Buffer(n)+1, (Ubound(Buffer) - n) * Sizeof(Buffer(n)))
         Clear Buffer(Ubound(Buffer)), 0, Sizeof(Buffer(n))
         Redim Preserve Buffer(LBound(Buffer) To Ubound(Buffer) - 1)
      End If
   Else
      n += 1
   End If
Loop

For i As Integer=0 To UBound(Buffer)
    Print "Buffer(" & i & ")= " & Buffer(i)
Next i

Sleep
SARG
Posts: 1088
Joined: May 27, 2005 7:15
Location: FRANCE

Re: How Can I remove empty string In dynamic Array

Postby SARG » Jul 16, 2015 23:23

Hi,

My try.

Code: Select all

dim Buffer() as string

redim Buffer(0 to 6)

For i As Integer=0 To UBound(Buffer)
   if i=0 or i=1 or i=3 then
       Buffer(i)=""
   else
       Buffer(i)="item" & i
   end if
Next i

Dim As Long empty=-1

For i As Long =LBound(buffer) To UBound(Buffer)
   If buffer(i)=""   Then
      if empty=-1 Then empty=i
      Continue For
   EndIf
   If empty=-1 Then Continue For
   Swap buffer(i),buffer(empty)
   empty+=1
Next

ReDim preserve buffer(LBound(buffer) To empty-1)

For i As Integer=0 To UBound(Buffer)
    Print "Buffer(" & i & ")= " & Buffer(i)
Next i

Sleep
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: How Can I remove empty string In dynamic Array

Postby Tourist Trap » Jul 17, 2015 5:06

SARG wrote:Hi,
My try.

Hi Sarg,where did you get this? It's seems to execute at constant time whatever the size of the array.
Ok mistakes in the test.

Code: Select all

''See other version below...
Last edited by Tourist Trap on Jul 17, 2015 11:31, edited 1 time in total.
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 17, 2015 5:52

When you call 'SARG1(buffer())', the buffer() has been already "cleaned" by 'FXM1(buffer())'.

In Function SARG1(Buffer() As String) As Long:
Two cases are not taken into account => runtime error on 'ReDim preserve Buffer(LBound(Buffer) To empty-1)'
- Buffer() fully empty,
- Buffer() not containing any empty string,
otherwise, very good code.

For example:

Code: Select all

Function SARG1(Buffer() As String) As Long
    Dim As Long empty=-1
   
    For i As Long =LBound(buffer) To UBound(Buffer)
       If Buffer(i)=""   Then
          if empty=-1 Then empty=i
          Continue For
       EndIf
       If empty=-1 Then Continue For
       Swap Buffer(i),Buffer(empty)
       empty+=1
    Next
   
    If empty = 0 Then
       Erase Buffer
    Elseif empty > 0 Then
       ReDim preserve Buffer(LBound(Buffer) To empty-1)
    End If

    Return (Ubound(Buffer) - LBound(Buffer))
End Function 'SARG1
SARG
Posts: 1088
Joined: May 27, 2005 7:15
Location: FRANCE

Re: How Can I remove empty string In dynamic Array

Postby SARG » Jul 17, 2015 7:33

Hi,

fxm wrote:otherwise, very good code.
Thanks.

fxm wrote: Two cases are not taken into account => runtime error on 'ReDim preserve Buffer(LBound(Buffer) To empty-1)'
- Buffer() fully empty,
- Buffer() not containing any empty string,
It was a bit late when I coded that...
Anyway as always you are right, "The Devil is in the details" ;-)
grindstone
Posts: 726
Joined: May 05, 2015 5:35
Location: Germany

Re: How Can I remove empty string In dynamic Array

Postby grindstone » Jul 17, 2015 8:55

Hello!

Anyone to beat this performance?

Code: Select all

ReDim As String Buffer(0 To 1000000)
Dim As Integer i,j
Dim As Double tr

''Write some buffer with holes
Randomize Timer
For i As Integer=0 To UBound(Buffer)
   If Rnd >.5 Then
      Buffer(i)=""
   Else
      Buffer(i)="item" & i
   End If
Next i

'print buffer contents before removing
'For i = LBound(Buffer) To UBound(Buffer)
'   ? buffer(i);"*"
'Next

'remove empty strings
? "----------------"
tr = Timer
j = LBound(Buffer)
For i = LBound(Buffer) To UBound(Buffer)
   If Len(Buffer(i)) Then
      Swap buffer(i),buffer(j)
      j += 1
   EndIf
Next

'redim array
If j > LBound(Buffer) Then
   ReDim Preserve Buffer(LBound(Buffer) To j-1)
Else
   ReDim Preserve Buffer(LBound(Buffer) To j)
EndIf

? "Time: ";Timer - tr

'print buffer contents after removing
? "----------------"
'For i = LBound(Buffer) To UBound(Buffer)
'   ? buffer(i);"*"
'Next

Sleep

Regards
grindstone
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 17, 2015 10:49

The main difference with the SARG's version is due to the use of LEN() to test the string element (empty or not empty) which is faster.
If LEN() is used in SARG'version, these two versions become comparable for execution time.

Code: Select all

Function SARG1optimized(Buffer() As String) As Long
    Dim As Long empty=-1
   
    For i As Long =LBound(buffer) To UBound(Buffer)
       If Len(Buffer(i))=0 Then
          if empty=-1 Then empty=i
          Continue For
       EndIf
       If empty=-1 Then Continue For
       Swap Buffer(i),Buffer(empty)
       empty+=1
    Next
   
    If empty = 0 Then
       Erase Buffer
    Elseif empty > 0 Then
       ReDim preserve Buffer(LBound(Buffer) To empty-1)
    End If

    Return (Ubound(Buffer) - LBound(Buffer))
End Function 'SARG1
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: How Can I remove empty string In dynamic Array

Postby Tourist Trap » Jul 17, 2015 11:26

Ok this time I've made some correction. This below should be better for test comparison.
Dodicat method is also included now.

[EDIT]: See updated fxm version in next post

Just a detail however, use Initialize() before variable declaration just for it will call Randomize before Rnd is used.

Code: Select all

'(...)
Initialize()
Dim Shared As Long _loopCounter
Dim Shared As String buffer(), initialBuffer(), resultBuffer()
Dim As Long _maxItemAmount = 6+Rnd*48                                    '* 
   ReDim buffer(0 to _maxItemAmount)
   ReDim initialBuffer(0 to _maxItemAmount)
   ReDim resultBuffer(0 to _maxItemAmount)
Dim As Long resultUBound
''---------------------------------------------------------------------MAIN
'(...)
Last edited by Tourist Trap on Jul 17, 2015 14:15, edited 2 times in total.
fxm
Posts: 9700
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How Can I remove empty string In dynamic Array

Postby fxm » Jul 17, 2015 13:45

Compiling with -exx => Aborting due to runtime error 6 (out of bounds array access) at line 67 of d:\Documents and Settings\t0003830\Mes documents\FBIde0.4.6r4_fbc1.04.0\FBIDETEMP.bas::TOURIST2()
(line 67) If i>0 And _Buffer(i-1) = "" Then invalidItemCounter += 1
Error because for i=0, out of bound of '_Buffer(i-1)'.

Correction:
(line 67) If i>0 Andalso _Buffer(i-1) = "" Then invalidItemCounter += 1
=> OK

In addition, to optimize execution code, we can replace anywhere the test on the string '_Buffer(x)' by a test on 'Len(_Buffer(x))':

Code: Select all

'' Null string item removal from an array of string  -  comparison tests
''=========================================================================
Function TOURIST1(_Buffer() As string) As Long
    Dim As String TemporaryBuffer()
    ReDim TemporaryBuffer(UBound(_Buffer))
    Dim As Integer temporaryBufferItemCounter = 0
    For i As Integer=0 To UBound(_Buffer)
       If Len(_Buffer(i)) > 0 Then
        TemporaryBuffer(temporaryBufferItemCounter) = _Buffer(i)
        temporaryBufferItemCounter += 1
       EndIf
    Next i
    For i As Integer=0 To temporaryBufferItemCounter
        _Buffer(i) = TemporaryBuffer(i)
    Next i
    ReDim Preserve _Buffer(0 To temporaryBufferItemCounter - 1)

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'TOURIST1
''=========================================================================
Function FXM1(_Buffer() As string) As Long
    Dim n As Integer = Lbound(_Buffer)
    Do While n <= Ubound(_Buffer)
       If Len(_Buffer(n)) = 0 Then
          If Ubound(_Buffer) = Lbound(_Buffer) Then
             Erase _Buffer
          Else
             For i As Integer = n To Ubound(_Buffer) - 1
                Swap _Buffer(i), _Buffer(i+1)
             Next i
             Redim Preserve _Buffer(LBound(_Buffer) To Ubound(_Buffer) - 1)
          End If
       Else
          n += 1
       End If
    Loop

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'FXM1
''=========================================================================
Function GRINDSTONE1(_Buffer() As string) As Long
    Dim As Long j = LBound(_Buffer)
    For i As Long = LBound(_Buffer) To UBound(_Buffer)
        If Len(_Buffer(i)) Then
            Swap _Buffer(i),_Buffer(j)
            j += 1
        EndIf
    Next
   
    'redim array
    If j > LBound(_Buffer) Then
        ReDim Preserve _Buffer(LBound(_Buffer) To j-1)
    Else
        ReDim Preserve _Buffer(LBound(_Buffer) To j)
    EndIf

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'GRINDSTONE1
''=========================================================================
Function TOURIST2(_Buffer() As string) As Long
    Dim As Integer i, n, invalidItemCounter
         i = 0
         n = 1
         invalidItemCounter = 0
    While i <= UBound(_Buffer)
        If Len(_Buffer(0)) = 0 Then invalidItemCounter += 1
        If i>0 Andalso Len(_Buffer(i-1)) = 0 Then invalidItemCounter += 1
        While Len(_Buffer(i))=0 And i+n <= UBound(_Buffer)
            Swap _Buffer(i), _Buffer(i+n)
            n += 1
        Wend
        n = 1
        i += 1
    Wend
    ReDim Preserve _Buffer(UBound(_Buffer) - invalidItemCounter -1)

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'TOURIST2
''=========================================================================
Function SARG1(_Buffer() As String) As Long
   Dim As Long empty=-1
   For i As Long =LBound(_Buffer) To UBound(_Buffer)
         If Len(_Buffer(i))=0   Then
              If  empty=-1 Then empty=i
              Continue For
         EndIf
         If empty=-1 Then Continue For
           Swap _Buffer(i),_Buffer(empty)
           empty+=1
   Next i   
   If empty = 0 Then
           Erase _Buffer
   ElseIf empty > 0 Then
           ReDim Preserve _Buffer(LBound(_Buffer) To empty-1)
   End If
     
    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'SARG1
''=========================================================================
Function DODICAT1(_Buffer() As string) As Long
    dim as integer n = -1
    do
        n=n+1
        If Len(_Buffer(n))=0 then
            'arraydelete(_Buffer(),n)
            If n>=Lbound(_Buffer) And n<=Ubound(_Buffer) Then
                For x As Integer=n To Ubound(_Buffer)-1
                    _Buffer(x)=_Buffer(x+1)
                Next x
            ReDim Preserve _Buffer(Lbound(_Buffer) To Ubound(_Buffer)-1)
            End If
           
            n=n-1
        EndIf
        if n=ubound(_Buffer) then exit do '(the ubound changes of course)
    Loop

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'DODICAT1
''=========================================================================
Function TEST1(_Buffer() As string) As Long
    ''Must provide the new _Buffer resized
    ''Add your method here

    Return (Ubound(_Buffer) - LBound(_Buffer))
End Function 'TEST1
''=========================================================================
Declare Function Maximum(ByVal a As Double, ByVal b As Double) As Double
Declare Sub Initialize()
Declare Sub BufferCreate()
Declare Sub ShowBuffer(_bufferToShow() As String, ByVal _title As String = "BUFFER CONTENT")
Declare Sub SaveBuffer(_bufferToSave() As String, _savedBuffer() As String)
Declare Sub RestoreBuffer(_bufferToBeRestored() As String, _savedBuffer() As String)
Dim Shared As Long _loopCounter
Dim Shared As String buffer(), initialBuffer(), resultBuffer()
Dim As Long _maxItemAmount = 6+Rnd*48                                    '* 
    ReDim buffer(0 to _maxItemAmount)
    ReDim initialBuffer(0 to _maxItemAmount)
    ReDim resultBuffer(0 to _maxItemAmount)
Dim As Long resultUBound
''---------------------------------------------------------------------MAIN
Initialize()
BufferCreate()
Cls
ShowBuffer(Buffer(), "INITIAL BUFFER")
Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
Sleep
SaveBuffer(Buffer(), initialBuffer())
        Cls
        Dim As Double testTime0 = Timer
        ''*************************************************************TEST0
         resultUBound = TOURIST1(buffer())                                    '*
         testTime0 = Timer - testTime0
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST0 = TOURIST1")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime0 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep
       
        Cls
        Dim As Double testTime1 = Timer
        ''*************************************************************TEST1
         resultUBound = FXM1(buffer())                                    '*
         testTime1 = Timer - testTime1
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST1 = FXM1")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime1 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep
       
        Cls
        Dim As Double testTime2 = Timer
        ''*************************************************************TEST2
         resultUBound = GRINDSTONE1(buffer())                             '*
         testTime2 = Timer - testTime2
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST2 = GRINDSTONE1")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime2 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep
         
        Cls
        Dim As Double testTime3 = Timer
        ''*************************************************************TEST3
         resultUBound = TOURIST2(buffer())                                    '*
         testTime3 = Timer - testTime3
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST3 = TOURIST2")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime3 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep
       
        Cls
        Dim As Double testTime4 = Timer
        ''*************************************************************TEST4
         resultUBound = SARG1(buffer())                                    '*
         testTime4 = Timer - testTime4
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST4 = SARG1")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime4 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep     
       
        Cls
        Dim As Double testTime5 = Timer
        ''*************************************************************TEST5
         resultUBound = DODICAT1(buffer())                                    '*
         testTime5 = Timer - testTime5
       
        ReDim resultBuffer(0 to resultUBound)
        For _loopCounter = 0  To UBound(resultBuffer) - LBound(resultBuffer)
             resultBuffer(_loopCounter ) = buffer(LBound(resultBuffer) + _loopCounter)
        Next _loopCounter
       
        ShowBuffer(resultBuffer(), "RESULT BUFFER TEST5 = DODICAT1")
         Locate 19, 1 : ? "Time ellapsed * 1e+5= "; testTime5 * 1e+5
        RestoreBuffer(buffer(), initialBuffer())
         Locate 25, 30 : ? "PRESS A KEY TO CONTINUE" ;
         Sleep     
       
       
Cls
? "CONCLUSION:"
? "-----------"
Locate 1, 14 : ? " On a array size = "; _maxItemAmount
Locate 2, 14 : ? " Test0 = TOURIST1 runs on "; testTime0
Locate 3, 14 : ? " Test1 = FXM1 runs on "; testTime1
Locate 4, 14 : ? " Test2 = GRINDSTONE1 runs on "; testTime2
Locate 5, 14 : ? " Test3 = TOURIST2 runs on "; testTime3
Locate 6, 14 : ? " Test4 = SARG1 runs on "; testTime4
Locate 7, 14 : ? " Test5 = DODICAT1 runs on "; testTime5

''Draw little graph
For _loopCounter = 12 To 19
    Locate _loopCounter, 14 : ? "|";
Next
For _loopCounter = 1 To 50
    Locate 20, 12+_loopCounter : ? "-";
Next
''compute max time
Dim As Double maxTime
maxTime = Maximum(testTime0, testTime1)
maxTime = Maximum(maxTime, testTime2)
maxTime = Maximum(maxTime, testTime3)
maxTime = Maximum(maxTime, testTime4)
maxTime = Maximum(maxTime, testTime5)
Locate 21, 16 : ? "'"
Locate 22, 16 : ? "TRS1"
Locate -Int(testTime0*8/maxTime)+20, 16
     ? IIf(Int(testTime0*8/maxTime) = 0, "X", "*");
Locate 21, 22 : ? "'"
Locate 22, 22 : ? "FXM1"
Locate -Int(testTime1*8/maxTime)+20, 22
     ? IIf(Int(testTime1*8/maxTime) = 0, "X", "*");
Locate 21, 28 : ? "'"
Locate 22, 28 : ? "GND1"
Locate -Int(testTime2*8/maxTime)+20, 28
     ? IIf(Int(testTime2*8/maxTime) = 0, "X", "*");
Locate 21, 34 : ? "'"
Locate 22, 34 : ? "TRS2"
Locate -Int(testTime3*8/maxTime)+20, 34
     ? IIf(Int(testTime3*8/maxTime) = 0, "X", "*");
Locate 21, 40 : ? "'"
Locate 22, 40 : ? "SRG1"
Locate -Int(testTime4*8/maxTime)+20, 40
     ? IIf(Int(testTime4*8/maxTime) = 0, "X", "*");
Locate 21, 46 : ? "'"
Locate 22, 46 : ? "DOD1"
Locate -Int(testTime5*8/maxTime)+20, 46
     ? IIf(Int(testTime5*8/maxTime) = 0, "X", "*");
   
Sleep : End
''-------------------------------------------------------------------------
Function Maximum(ByVal a As Double, ByVal b As Double) As Double
    Return IIf(a > b, a, b)
End Function
Sub Initialize()
    Screen 0
    Cls
    Randomize Timer
End Sub
Sub BufferCreate()
''Create a buffer  -- array of string
''And fill it with null and not null items
    For _loopCounter = 0 To UBound(buffer)
        If Rnd*100 > 49 Then
             buffer(_loopCounter)="item" & _loopCounter
        Else
             buffer(_loopCounter)=""
        End If
    Next _loopCounter
End Sub
Sub ShowBuffer(_bufferToShow() As String, ByVal _title As String = "BUFFER CONTENT")
''Display Buffer
     ? _title
    For _loopCounter = 1 To Len(_title)
         ? "-" ;
    Next _loopCounter
     ?
    For _loopCounter = 0 To UBound(_bufferToShow)
         Locate (_loopCounter) Mod 15 + 3, (26*Int((_loopCounter ) / 15))
        ? "index="; _loopCounter; " Bufr("; _loopCounter; ")="; Buffer(_loopCounter)
    Next _loopCounter
     Locate 18, 1 : ? "UBound(Buffer)="; UBound(_bufferToShow) : ?
End Sub
Sub SaveBuffer(_bufferToSave() As String, _savedBuffer() As String)
    For _loopCounter = 0 To UBound(_bufferToSave)
         _savedBuffer(_loopCounter) = _bufferToSave(_loopCounter)
    Next _loopCounter
End Sub
Sub RestoreBuffer(_bufferToBeRestored() As String, _savedBuffer() As String)
''Restore initial buffer
    ReDim _bufferToBeRestored(UBound(_savedBuffer))
    For _loopCounter = 0 To UBound(_savedBuffer)
         _bufferToBeRestored(_loopCounter) = _savedBuffer(_loopCounter)
    Next _loopCounter
End Sub
'----eof----

Return to “General”

Who is online

Users browsing this forum: No registered users and 6 guests