calculation becoming slow-delay accumulation

[/Private Function calculate()


cx = (X - x1) * xratio
cy = (Y - y1) * yratio


If cx < 0 Then
xd = 0
cx = (0 - cx)
Else
xd = 1
End If

If cy < 0 Then
yd = 2
cy = (0 - cy)
Else
yd = 3
End If


cx = CInt(cx)
cy = CInt(cy)

If cx = 0 Then
xr = 0
yr = 1
ElseIf cy = 0 Then
yr = 0
xr = 1
Else


crflag = 1

If cx < cy Then
cr = cx / cy
Else
cr = cy / cx
End If


For cri = 1 To range
crtemp = (cr * cri)
crtemp = CInt(crtemp) - crtemp
crtemp = Format(crtemp, "####0.00000")
If crtemp < 0 Then
crtemp = 0 - crtemp
End If
If crflag = 1 Then
crlow = crtemp
crlowi = cri
crflag = 0
Else
If crtemp < crlow Then
crlow = crtemp
crlowi = cri
End If
End If
Next cri

If cx < cy Then
xr = crlowi
yr = CInt(crlowi / cr)
Else
yr = crlowi
xr = CInt(crlowi / cr)
End If

For cri = range To 1 Step -1
If (xr Mod cri) = 0 And (yr Mod cri) = 0 Then
xr = xr / cri
yr = yr / cri
End If
Next cri


tempr = xr
xr = yr
yr = tempr

End If


xr1 = xr Mod 10
xr = (xr - xr1) / 10
xr2 = xr Mod 10
xr = (xr - xr2) / 10
xr3 = xr Mod 10
xr = (xr - xr3) / 10
xr4 = xr Mod 10


yr1 = yr Mod 10
yr = (yr - yr1) / 10
yr2 = yr Mod 10
yr = (yr - yr2) / 10
yr3 = yr Mod 10
yr = (yr - yr3) / 10
yr4 = yr Mod 10



cx1 = cx Mod 10
cx = (cx - cx1) / 10
cx2 = cx Mod 10
cx = (cx - cx2) / 10
cx3 = cx Mod 10



cy1 = cy Mod 10
cy = (cy - cy1) / 10
cy2 = cy Mod 10
cy = (cy - cy2) / 10
cy3 = cy Mod 10
cy = (cy - cy3) / 10
cy4 = cy Mod 10



End Function]



i am using this function in my program..its being called repeatedly(more than 200-300 times)..initially,it takes no delay for execution..bt as it proceeds, the time taken for executing the function is becoming higher..this slows down my software..how can i solve it???

Welcome to the forums :wave:

You could start by declaring your variables, using meaningful variable names, actually returning a result (or change it from a Function to a Sub if it's not returning anything), and commenting your code so we don't have to spend twenty minutes trying to figure out what it's supposed to do.

Also, when pasting code, please use the CODE brackets so it looks like this:

Code:

---

  Private Sub HelloWorld()
      MsgBox "Hello World"
  End Sub

---

As stated, we can't answer your question because it is not at all clear what you are trying to calculate. What are the output values? For example, given this section:

Code:

---

xr1 = xr Mod 10
xr = (xr - xr1) / 10
xr2 = xr Mod 10
xr = (xr - xr2) / 10
xr3 = xr Mod 10
xr = (xr - xr3) / 10
xr4 = xr Mod 10

---

which variables do you need to save? That will tell us what we can and cannot trim away.

k..ill explain the code..first values cx and cy are calculated.it has max value of 8000.the next section calculates two values xr and yr..then individual bytes of cx,cy,xr and yr are taken in variables cx1,cx2,cx3.......yr1,yr2...at the end.
ie..eg..if cx=856 then cx1=6 cx2=5 cx3=8 cx4=0.
now ill explain the code in between which calculates xr and yr.
the variable 'range' has a value 10.
the aim is to minimise the cx an cy variables to a minimum ratio xr (xratio) and yr with least error.for this the value cx/cy is multiplied by values 1 to 10 in a for loop.the value which is most close to an integer value is choosen and the ratios are calculated with that value.

ill explain my need..i have to values cx and cy ranging to maximum of 1200.i need to minimise cx and cy by same ratio.
ie if cx=800,cy=300..then the result should be xr=8 and yr=3
also if cx=61,cy=10 then xr=6 and yr=1
that is..i need to minimise the cx and cy values to a minimum value in the same ratio.

the last section of the function which u asked about just splits the variables cx,cy,xr,yr into individual numbers.ones place,tens place,hundredth place etc..

there are some other statements in the code whose use i cannot explain with only dis function..plzz ignore those and help me..

AJ

Building on what Lenggries suggested, you have
these 2 loops ...

Code:

---

For cri = 1 To range
    crtemp = (cr * cri)
    crtemp = CInt(crtemp) - crtemp
    crtemp = Format(crtemp, "####0.00000")
    If crtemp < 0 Then
        crtemp = 0 - crtemp
    End If
    If crflag = 1 Then
        crlow = crtemp
        crlowi = cri
        crflag = 0
    Else
        If crtemp < crlow Then
            crlow = crtemp
            crlowi = cri
        End If
    End If
Next cri

---

Code:

---

For cri = range To 1 Step -1
    If (xr Mod cri) = 0 And (yr Mod cri) = 0 Then
        xr = xr / cri
        yr = yr / cri
    End If
Next cri

---

You don't seem to have set the value of range anywhere,
but my guess is that it increases as you get to call #300, and
thus is causing the increase in execution time.

Please correct me if I'm wrong.

Spoo

OK, I think I figured out your algorithm, but there are a ton of problems with it. Before I get into those, though, are you sure your algorithm is what you think it is? Consider this quote of yours:

Code:

---

ie if cx=800,cy=300..then the result should be xr=8 and yr=3
also if cx=61,cy=10 then xr=6 and yr=1

---

When I step through your code, I get different results...

If cx = 800, cy = 300, then xr = 21 and yr = 8
If cx = 61, cy = 10, then xr = 37 and yr = 6

In order to get your results, I need to change

Code:

---

        If cx < cy Then
            xr = crlowi
            yr = CInt(crlowi / cr)
        Else
            yr = crlowi
            xr = CInt(crlowi / cr)
        End If

---

to

Code:

---

        If cx > cy Then
            xr = crlowi
            yr = CInt(crlowi * cr)
        Else
            yr = crlowi
            xr = CInt(crlowi * cr)
        End If

---

But that change restricts the larger number to the range, rather than just the smaller number.

So before we try to speed your algorithm up, can you first make sure your algorithm works at all?

the algorithm is correct..i hav checked it..i dont think the problem is with calculations..will explain the reason..forget what we discussed till now..i hav changed the program..nw it looks like..

Code:

---

i = 1
cdraw = 0

while cdraw <= clines
       
   
        cdraw = cdraw + 1
       
       
        MSComm1.Output = "s"

           
        pd = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(pd)
       
        xd = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(xd)
       
        yd = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(yd)
       
        xr1 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(xr1)
       
        xr2 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(xr2)
       
        xr3 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(xr3)
       
        xr4 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(xr4)
       
        yr1 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(yr1)
           
        yr2 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(yr2)
           
        yr3 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(yr3)
           
        yr4 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(yr4)
           
        cx1 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cx1)
           
        cx2 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cx2)
           
        cx3 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cx3)
           
        cy1 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cy1)
           
        cy2 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cy2)
           
        cy3 = Val(Mid(newline, i, 1))
          i = i + 1
            MSComm1.Output = Chr$(cy3)
           
        cy4 = Val(Mid(newline, i, 1))
        i = i + 1
            MSComm1.Output = Chr$(cy4)

                     
        'waits till process is complete
        Do Until recv = "c"
            DoEvents
            DoEvents
        Loop

   
Wend

---

ill explain the whole thing..the program sends a packet of data(each packet contains 19 bytes namely s,pd,xd,yd,xr1,xr2....yr4) to serial port and waits for an input "c" from the serial port..if c is recieved.it sends the next packet of data.the 'recv' variable stores the character recieved in the mscomm_oncomm event.'clines' is the total number of packets..the string 'newline' contains the data for all the packets sequentially..there can be upto 300-400 packets and hence the string newline may contain 300*18 characters(numbers).
now executing this program..i faced the same delay problem.at first it took no time sending each packet but it slows down as the packet number increases.(the delay becomes higher as packet nmbr reaches 200 and more.).i think the problem is continous execution of a same loop..

AJ

If I understand you ..

• at pkt-1, newline = "123456789012345678"
• at pkt-2, newline = "123456789012345678abcdefghijklmnopqr"

where ..

1. at pkt-1, newline is 18 chr's long
2. at pkt-2, newline is 36 chr's long ... which of these 3 cases applies? ...
   
   • 1st 18 are repeats of pkt-1, and 2nd 18 are unique
   • 1st 18 are unique, and 2nd 18 are unique
   • something else

Could you please clarify which of the 3 cases applies.

It seems that the mere fact that at pkt 300 you have a
5,400-chr string to process is what is causing the increase
in execution time.

However, depending on what your clarification is, a "smarter"
algo may be available.

Spoo

That seems like a lot of code for a simple transfer of data

Code:

---

i = 1
cdraw = 0
While cdraw <= clines
    cdraw = cdraw + 1
    mscomm1.output = "s"
    mscomm1.output Mid$(newline, i, 18)
    i = i + 18
    'waits till process is complete
    Do Until recv = "c"
        DoEvents
        DoEvents
    Loop
Wend

---

does the same job.

Using DoEvents will slow up the whole process - you ought to be triggering the sending of the data through the OnComm event - if for any reason the other end doesn't send a "c" then you go into an infinite loop.

Quote:

---

Originally Posted by Spoo

AJ

If I understand you ..

• at pkt-1, newline = "123456789012345678"
• at pkt-2, newline = "123456789012345678abcdefghijklmnopqr"

where ..

1. at pkt-1, newline is 18 chr's long
2. at pkt-2, newline is 36 chr's long ... which of these 3 cases applies? ...
   
   • 1st 18 are repeats of pkt-1, and 2nd 18 are unique
   • 1st 18 are unique, and 2nd 18 are unique
   • something else

Could you please clarify which of the 3 cases applies.

It seems that the mere fact that at pkt 300 you have a
5,400-chr string to process is what is causing the increase
in execution time.

However, depending on what your clarification is, a "smarter"
algo may be available.

Spoo

---

the length of newline is fixed..wat the loop does is selecting first 18 characters,sends it,waits for 'c',sends next 18 characters in newline,waits for 'c' and so on..so the string newline doesnot changes at any part of the pgm..bt the diff comes here..while the pgm sends the first packet it reads the first 18 characters but for the 300 th packet it has to read the characters from the position of 299*18..

Quote:

---

Originally Posted by Doogle

That seems like a lot of code for a simple transfer of data

Code:

---

i = 1
cdraw = 0
While cdraw <= clines
    cdraw = cdraw + 1
    mscomm1.output = "s"
    mscomm1.output Mid$(newline, i, 18)
    i = i + 18
    'waits till process is complete
    Do Until recv = "c"
        DoEvents
        DoEvents
    Loop
Wend

---

does the same job.

Using DoEvents will slow up the whole process - you ought to be triggering the sending of the data through the OnComm event - if for any reason the other end doesn't send a "c" then you go into an infinite loop.

---

k..i can simplify the code..thanx for advice..but my main problem still exists..the pgm is interfaced with an external microcontroller..when i debugged the delay area ,i found that the data sending section works fine,the delay comes in the next part.ie after 'c' is recieved ,it takes a bit higher time to start the next working of loop..as u told the problem could be with doevents..how can i write the program do events..my aim is just to wait until 'c' is recieved..the recieved character is recieved in 'recv' variable in oncomm event..when i tried without doevents,the program hangs.wat can i do now?

I'd introduce the concept of a Queue. Split up the newline string into parts of 18, add each one to the queue. When you receive a "c" from the other end send and then delete the next item in the Queue. It'll just keep going until the Queue is empty.

Something like this:
In the Declarations Section of your Form:

Code:

---

Private sendQueue As Collection

---

In the Form_Load event:

Code:

---

Set sendQueue = New Collection

---

Where you currently have the Do While Loop, replace it with:

Code:

---

Dim intJ As Integer
cdraw = 0
Do
    intJ = (18 * cdraw) + 1
    sendQueue.Add Mid$(newline, intJ, 18)
    cdraw = cdraw + 1
Loop Until cdraw > clines - 1
Call SendData

---

and remove the DoEvents Loop.

The MSComm1.OnComm event:

Code:

---

Private Sub MSComm1_OnComm()
Dim strRec As String
Select Case MSComm1.CommEvent
    Case comEvReceive
        strRec = MSComm1.Input
        If strRec = "c" Then
            If sendQueue.Count > 0 Then
                Call SendData
            End If
        End If
End Select
End Sub

---

and add a new subroutine:

Code:

---

Private Sub SendData()
Dim strToSend As String
strToSend = sendQueue.Item(1)
MSComm1.output = strToSend
sendQueue.Remove (1)
End Sub

---

Thanx a lot..!!!!
that worked fine..

Has it made much difference to the speed or is that still an outstanding issue ?

my pblm is fully solved..i made small changes in the code u suggested to suit with my program..i think the doevents statement made the whole trouble..the pblm i faced was the time taken to execute next iteration of loop after recieving "c" was increasing as the packet nmbr goes high..now it takes same time(0 time) for whole of the packets.
thanx dude.:)

AJ

Glad you and Doogle worked things out.

I'd only add that the your clarification in post #10
that "the length of newline is fixed" seems to have
been a key piece of info.

Spoo