list box limits

[raymw]

looking good, so far. Thanks Paul, I dropped your code into my program, ran it (had to do a few minor corrections, as you said you'd not compiled it) and it ran the routine in 3.64 seconds, instead of the previous 83! Now I need to modify it as mentioned to get it to work with other variations of data and sort out the comments (). I was not aware of the 'exit for', which tidies things up a bit.

[raymw]

Well I've got it working as I want, but probably could be faster. It takes 14 seconds, compared to 83 before. I think that is tolerable for the large files. I had to use Format, to take care of the different number of decimal places, but I'm not sure if I could speed up that process. The biggest improvement was using the string pointer indexing.

The code that puzzled you has to be included, or rather something that does the same job i.e, find odd code in array1, and shove it into arrayo.   

kk = InStr (LCase(array1(i)),Any "bcdehijklmopqrstuvw" )
      If kk>0 Then arrayo(i)=" "+Right(array1(i),Len (array1(i))-kk+1)

it's to take care of all the other values that may or may not be present in a line of G-code e.g. M, I, J etc, (for example, a line such as g2 x15 y-29 i34 j5 ) but such lines are often infrequent and they do not deserve a separate list. That bit of code takes 4 seconds for the million line file. I altered your function, to allow the passing of a formatting string

I'm not sure if this area can be easily improved wrt speed. Would it be faster in 64bit, or if the function was inlined?

Code Select Expand

    Function GetDataToarrays( DestArray() as String, ByVal nLineNum as Long, ByVal nStartPos as Long, ByVal fs as String) as Long
   ' Get the characters from the current position up to the first blank space or end of line.
   ' Return the new line parsing offset so the line can continue to be parsed.
   Dim as String tempString
   Dim i as Long
   
   
   
   For i  = nStartPos To Len(Array1(nLineNum)) - 1
      If Array1(nLineNum)[i] = 32  Then ' space character
         Exit For
      Else
   
         tempString = Format(Val(Right(array1(nlinenum),Len (array1(nlinenum))-nstartpos-1)),fs)
         Exit For
      End If   
   Next
   DestArray(nLineNum) = tempString
   Function = i
End Function

' ------------------------------------------------------

Sub fill()  '  fills the columns by parsing array1

   Dim ln as String   ' line of code
   Dim k as Integer   ' counter
   Dim t as Integer   ' total chars in ln
   Dim r as String    ' result string if found
   Dim lns as String  ' rhs of line
   Dim kk as Integer
   
   '(130mm diam z 9mm deep)
   'N0001  G90
   'N0002  t32
   '(Begin Next Pass  at -3.000)
   'N0003  M06 S24000
   'N0004  M03
   'N34128  G01 X-17.5362 Y-7.0818 Z-2.3281
   'N34129  G01 X-17.5362 Y-7.0158 Z-2.3324
   'N34130  G01 X-17.5362 Y-6.9498 Z-2.3345
   'N34131  G01 X-17.5362 Y-6.8838 Z-2.3362
   'N34132  G01 X-17.5362 Y-6.8178 Z-2.3400
   'N34133  G01 X-17.5362 Y-6.7518 Z-2.3432
   'N34134  G01 X-17.5362 Y-6.6858 Z-2.3470

   Dim as Long lb = LBound(Array1)
   Dim as Long ub = UBound(Array1)
   Dim fs as String 'format string
   fs="#.0000"
   Dim as Double t1, t2     ' for timer
   t1 = Timer

   ' Read an process every line in Array1()
   For i as Long = lb To ub

     
       
      For k = 0 To Len(Array1(i)) - 1  ' go through line, character by character
     
         ' Let's use string pointer indexing because it is super cool and much easier
         ' to use that in other BASIC's. It also means we don't have to use expensive
         ' operations line UCASE, LEFT, MID, blah blah blah
         
         ' Format() is a slow FB function as well. Might want to consider not using it
         ' or replace with a faster locally developed version. It appears that your data
         ' is already formated to the correct number of digits so the benefit of Format
         ' seems a little redundant.
         
         ' Also, let's use a Select Case As Const so that a super fast jump table is
         ' created for comparisons.
         
         Select Case as Const Array1(i)[k]
         Case 40  ' (  comment - get out of way first in case x,y,z etc inside
               arrayo(i)=Right(array1(i),Len (array1(i))-k)
               Goto nextline 
         
            Case 78, 110     ' N n
               ' Fill arrayn() with data
               k = GetDataToarrays(arrayn(), i, k,"0000")               
            Case 71, 103     ' G g
               k = GetDataToarrays(arrayg(), i, k,"00")               
            Case 88, 120     ' X x
               k = GetDataToarrays(arrayx(), i, k,fs)               
            Case 89, 121     ' Y y
               k = GetDataToarrays(arrayy(), i, k,fs)               
            Case 90, 122     ' Z z
               k = GetDataToarrays(arrayz(), i, k,fs)               
            Case 65, 97      ' A a
               k = GetDataToarrays(arraya(), i, k,fs)               
            Case 70, 102     ' F f
               k = GetDataToarrays(arraya(), i, k,fs)   
          End Select     
               'anything else goes in comments           
 
  Next         
                                                                                       'from here
             'arrayo also holds other codes, except N,G,X,Y,Z,A,F
   '   'check for m, t, etc
      kk = InStr (LCase(array1(i)),Any "bcdehijklmopqrstuvw" )
      If kk>0 Then arrayo(i)=" "+Right(array1(i),Len (array1(i))-kk+1)
               
   '   'check for special characters       
      kk = InStr (array1(i),Any "!£$%^&*{}:@~#:<>?" )
     If kk>0 Then arrayo(i)=" "+Right(array1(i),Len (array1(i))-kk+1)
     
                                                                                         ' to here takes about 4 seconds for my million line test file
       
       nextline:         
                 
   Next  ' get next line
       
   
   t2 = Timer   

   ? t1,t2,t2-t1 ,"b4 assign"  'now 14 seconds....
       
   ' Assign the string arrays to the listboxes.
   
   SendMessage( HWND_FRMMAIN_code, VL_SETARRAY, Cast(WPARAM, VarPtr(Array1(0))) , Cast(LPARAM, UBound(Array1)) )
   SendMessage( HWND_FRMMAIN_VLISTn, VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayn(0))) , Cast(LPARAM, UBound(Arrayn)) )
   SendMessage( HWND_FRMMAIN_VLISTg,VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayg(0))) , Cast(LPARAM, UBound(Arrayg)) )
   SendMessage( HWND_FRMMAIN_VLISTx,VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayx(0))) , Cast(LPARAM, UBound(Arrayx)) )
   SendMessage( HWND_FRMMAIN_VLISTy,VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayy(0))) , Cast(LPARAM, UBound(Arrayy)) )
   SendMessage( HWND_FRMMAIN_VLISTz,VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayz(0))) , Cast(LPARAM, UBound(Arrayz)) )
   SendMessage( HWND_FRMMAIN_VLISTf, VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayf(0))) , Cast(LPARAM, UBound(Arrayf)) )
   SendMessage( HWND_FRMMAIN_VLISTo, VL_SETARRAY, Cast(WPARAM, VarPtr(Arrayo(0))) , Cast(LPARAM, UBound(Arrayo)) )
   SendMessage( HWND_FRMMAIN_VLISTa, VL_SETARRAY, Cast(WPARAM, VarPtr(Arraya(0))) , Cast(LPARAM, UBound(Arraya)) )
   

   ' Refresh the listboxes so that the changes can visibly be seen.

   SendMessage( HWND_FRMMAIN_code, VL_REFRESH, 0, 0)     
   SendMessage( HWND_FRMMAIN_VLISTn, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTg, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTx, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTy, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTz, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTf, VL_REFRESH, 0, 0)
   SendMessage( HWND_FRMMAIN_VLISTo, VL_REFRESH, 0, 0)   
   SendMessage( HWND_FRMMAIN_VLISTa, VL_REFRESH, 0, 0)
         
     
   gandf()
   hidew()

   t2 = Timer   

   ? t1,t2,t2-t1 ,"ready to go"      'Note, this time is not significantly greater than time to 'b4 assign'
           
End Sub


Thanks again for your help, this is now becoming useful, at least to me.

[Paul Squires]

Hi Ray,

I am not sure that this line in GetDataToSpaceChr is what you should be using:
tempString = Format(Val(Right(array1(nlinenum),Len (array1(nlinenum))-nstartpos-1)),fs)
Exit For

Basically, you're losing the whole benefit of the byte pointer scanning the line. Maybe try the code below - it scans the line up to the first non-numeric character and then exits the For/Next. Finally, the resulting string is formatted using your specified mask.

Code Select Expand


function GetDataToSpaceChr( DestArray() as string, _
                            byval nLineNum as long, _
                            byval nStartPos as long,
                            ByVal fs as String _
                            ) as Long
   ' Get the characters from the current position up to the first non-zero character or end of line.
   ' Return the new line parsing offset so the line can continue to be parsed. We start scanning
   ' from the position immediately following the found "N", "X", "Y", "Z", etc.
   dim as string tempString
   for i as long = nStartPos + 1 to len(Array1(nLineNum)) - 1
      select case Array1(nLineNum)[i]
         CASE 45, 46, 48 to 57     ' - . 0-9
            tempString = tempString & chr(Array1(nLineNum)[i])
         case else
            exit for
      end select   
   NEXT
   DestArray(nLineNum) = format(val(tempString), fs)
   function = i
END FUNCTION


I haven't looked at the other changes you made but I see that you are using a combination of INSTR, RIGHT, LCASE which will defeat the byte scanning as well. If I get time later I'll try looking at those areas as well.

[raymw]

Hi Paul, I copied your function above, and replaced mine (the editor comment/uncomment block is very useful), but I found your version was slower . I did comparisons on a couple of data files. The million or so lines, my time 14secs, yours 19. For 820000 line file mine 10 yours 14.5sec . I retested a few times, got the same results. Seems like the fb Val, is quite fast.

latest version, in 64 bit, 11.5 seconds for the million or so file. Having taken about 8hours testing, timing, etc, then I'll need to run the program about 30,000 times to recover that time....

[Paul Squires]

That's awesome that the built-in FB functions are speeding up the process. Cool. 
As an aside, make sure that you're always aware of the fact that the byte pointer approach is zero based whereas the FB functions are one based when dealing with character positions.

[raymw]

not wanting to drag it out more than necessary, but I wrote a simple ff/fb test (printing times to console)

Code Select Expand

#Include "string.bi"


Dim t4 as Double
Dim t1 as   Double
Dim t2 as Double
Dim t3 as Double
Dim vv as Double
Dim tempstring as String

Dim maxlines as Long
           
Dim arrayg as String
                               
arrayg="2000 anything)"   'random? string starting with number
maxlines =10000000
                t1=Timer
         For  i as Long =0 To  maxlines     'time empty loop
         Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3, "empty loop"
           
                 t1=Timer
         For  i as Long =0 To  maxlines
                vv= Val(arrayg)            'test setting a tempstring to a val of a string
                tempstring= Str(vv)       
         Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3 , "val"

          For i as Long =0 To maxlines
              tempstring=""
                For j as Long = 0 To Len(Arrayg) - 1          'test using pointers to numbers
                    Select Case Arrayg[j]
                        Case 45, 46, 48 To 57     ' - . 0-9
                        tempString = tempString & Chr(Arrayg [j])
             Case Else
            Exit For
           End Select   
               Next
        Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3 , "val2"

'--------------------------------------------------------------------------------


The approximate times I got for 32 bit compiler were 7.4secs and 15.3 sec, the fb val function being more or less twice as fast.
For 64bit compiler times were 6.3sec and 12.6 sec - a definite speed improvement.
I suppose I ought to vary the arrayg string length, number of numbers, etc., but maybe a tad ocd.

[raymw]

In my quest for speed, I wondered if it was faster for code to be in-line, instead of calling functons. I wrote another little timing program

Code Select Expand

Function sumup (a as Double, b as Double) as Double
      Dim c as Double
       c=a+b
       Function = c
End Function
       
       
  '---------------------------------------------
 
    Sub addup (a as Double,b as Double   )
   
    d=a+b
   End Sub   
'---------------------------------------------

Dim t1 as   Double
Dim t2 as Double
Dim t3 as Double

Dim a as Double
Dim b as Double
Dim c as Double
Dim Shared d as Double
Dim maxlines as Long
           
                         


maxlines =100000000
                t1=Timer
         For  i as Long =0 To  maxlines     'time empty loop
         Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3, "empty loop"
           
           
a=100
b=200       
                 t1=Timer
                 
                 
         For  i as Long =0 To  maxlines
                  'test calling function
                 
              c=sumup(a,b)
              c=sumup(a,b) 
              c=sumup(a,b)     
         Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3 , "by function"
?c

a=100
b=200       
                 t1=Timer
                 
                 
         For  i as Long =0 To  maxlines
                  'test calling subroutine
                 
              addup(a,b)
              addup(a,b)
              addup(a,b)
         Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3 , "by subroutine"
?d


a=100
b=200

          For i as Long =0 To maxlines
     
     c = a + b
     c = a + b
     c = a + b
        Next
                 t2=Timer
                 t3=t2-t1
?t1,t2,t3 , "by inline"
?c


and from my not extensive testing, it appears that the fastest is to use a subroutine, passing the result back as a share. Of course, I expect the results in the real world  will vary depending on the complexity of the calculations, but the overhead in calling a subroutine a number of times appears to be much less than I thought. Maybe I'll play around a bit more with shared values, and passing byref or byval. Mind you, there is always the chance that I've written something daft.
edited to add - I've since added a couple more timing loops, for subroutine and function using shared variables. for 100,000,000 iterations, function with shares 1.5 secs, subroutine with shares 0.13 secs, in line 0.32 secs .I think I've got some code re-writing to do.