[VBA] Voorkomen van vastlopen bij zware calculaties

[Robertobananas]

Ik heb een klein stukje code geschreven in VBA om divisors in triangle numbers te calculeren. Het idee is dat bij elk triangle number het aantal divisors wordt weergeven.

De (werkende) code die ik hiervoor gebruik is:

Visual Basic: TriangleNumbers

Sub Triangles2()

Dim divisors As Integer, number As Long, i As Long
Dim ws As Worksheet
Dim y As Long, x As Long
Dim Finder As Range
Dim TriNum As Long

Application.ScreenUpdating = False

Set ws = ActiveWorkbook.Worksheets("Sheet2")
Set Finder = ws.Range("A:A").Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious, False)
y = Finder.Row + 1
TriNum = 1

Stop
Stop

'Tri
Do Until y = 20001 'divisors >= 500
TriNum = ((y - 1) * ((y - 1) + 1)) / 2
ws.Cells(y, 1) = TriNum
    For i = 1 To Sqr(TriNum)
    If TriNum Mod i = 0 Then divisors = divisors + 1
    Next i
    divisors = divisors * 2
ws.Cells(y, 2) = divisors
divisors = 0
y = y + 1
Loop

MsgBox "DONE"
Application.ScreenUpdating = True

End Sub

Het stuk For i = 1 To Sqr(TriNum) is cruciaal. Door de wortel te gebruiken is de calculatie heel veel vlotter. Voorheen deed ik dit zonder 'Sqr'. De calculatie tijd was erg lang hierdoor.

Bijkomend probleem is dat Excel/VBA crashed als de calculaties te zwaar / te lang duren. Ik weet niet precies hoe dit komt. Uiteraard is een slimme en snelle oplossing beter dan 'dom' rekenwerk maar ik vraag me af hoe je kan voorkomen dat je code crashed op basis van zware berekeningen.

Iemand een idee?

[RobIII]

Het is niet 's werelds mooiste oplossing, maar dat is VBA toch al niet, dus: las op strategische plekken / momenten een DoEvents in; doe dat elke X iteraties (elke paar duizend ofzo, dus niet élke iteratie) en je applicatie zal niet meer 'freezen' (als in: de schermupdates e.d. zullen beter bijgehouden worden).

Robertobananas schreef op donderdag 12 mei 2016 @ 09:28:
Het stuk For i = 1 To Sqr(TriNum) is cruciaal. Door de wortel te gebruiken is de calculatie heel veel vlotter. Voorheen deed ik dit zonder 'Sqr'. De calculatie tijd was erg lang hierdoor.

Ik weet niet hoe slim VBA is, maar het is sowieso wel een 'goed gebruik' om zo'n berekening uit je lus te halen; nu zal je CPU (potentieel; afhankelijk van hoe 'slim' VBA is) elke iteratie een Sqr(TriNum) doen om te kijken of i al gelijk is aan de uitkomst daarvan.

code:

iterations = Sqr(TriNum)
For i = 1 To iterations

Een ander ding is: moet je élke iteratie die cellen updaten? Kun je de resultaten niet (tijdelijk) in een array o.i.d. mikkeren en dan, aan 't eind of elke X iteraties ofzo, die cellen in een 'batch' bijwerken? Het zijn vaak vooral dat soort fratsen (élke iteratie de UI bijwerken e.t.c., i.t.t. een progressbar o.i.d. bijwerken elke X iteraties, bijvoorbeeld elke 1% van het totale werk)) die a) geen toegevoegde waarde hebben voor de gebruiker en b) de hele zwik flink vertragen.

Robertobananas schreef op donderdag 12 mei 2016 @ 09:28:
Bijkomend probleem is dat Excel/VBA crashed als de calculaties te zwaar / te lang duren.

Crashed? Dan moet je eens gaan kijken naar je CPU koeling of voeding of weet-ik-wat. Maat ik vermoed dat je bedoelt dat je applicatie 'freezed' / 'bevriest' / 'unresponsive' is. En dat is een heel verschil en kan inderdaad kloppen. Daar heb je dus voorgenoemde DoEvents voor

Tot slot: ik heb niet inhoudelijk gekeken naar wat je berekent (en don't care ook ), maar op 't oog lijkt 't me een redelijk 'brute-force' aanpak van e.o.a. Als dat zo is: in 99% van de gevallen zijn er betere algoritmes; het kan zich lonen daar eens naar te kijken / zoeken.

[ Voor 78% gewijzigd door RobIII op 12-05-2016 10:27 ]

[farlane]

Crashed het of is 'tie gewoon heel druk en beweert Windows dat je "app is not responding"?

[Rannasha]

Je kunt het algoritme hoe dan ook een stuk efficienter maken. Zo te zien ben je geinteresseerd in het aantal delers, niet per se welke dat zijn.

Een driehoeksgetal is altijd te schrijven als D = n * (n + 1) / 2 (met n een natuurlijk getal). We kunnen het volgende opmerken: n en n+1 zijn relatief priem (dat wil zeggen: ze hebben geen priemfactoren gemeen en daarmee ook geen delers behalve 1).

Van het paar n en n+1 is altijd een van de twee even en dus deelbaar door 2. Laten we voor het gemak even aannemen dat n dat is (de rest van de beredenering is hetzelfde als n+1 het even getal is). Het driehoeksgetal D is nu te schrijven als (n/2) * (n+1). Hier geldt dat n/2 en n+1 ook relatief priem zijn en niet dezelfde delers hebben (dit volgt direct uit het feit dat de delers van n/2 een stricte deelverzameling zijn van de delers van n en we wisten al dat de verzameling delers van n en de verzameling delers van n+1 geen overlap hadden behalve het getal 1).

Nu geldt dat een deler van D altijd het product is van een deler van n/2 en een deler van n+1. Het aantal delers van D is dus gelijk aan het aantal producten van delers uit beide verzamelingen. En dat is gelijk aan het aantal delers van n/2 vermenigvuldigd met het aantal delers van n+1.

Als niet n, maar n+1 het even getal van de twee is, dan is het aantal delers van D gelijk aan het product van het aantal delers van n en het aantal delers van (n+1)/2.

Kortom: Je kunt het algoritme significant sneller maken door niet te zoeken naar delers van D, maar naar delers van n/2 en n+1 (als n even is) of delers van n en (n+1)/2 (als n oneven is).

[Robertobananas]

@ Roblll

DoEvents
Ik maak voor andere bestanden gebruik van deze functie. Ik heb echter op het internet van diverse bronnen gelezen dat DoEvents een no-go techniek is. Het is misschien verstandig om dit toch te implementeren. Bedankt.

Iteraties
Opzich een slim idee. Ik weet ook niet hoe VBA dit behandelt.

Ik vraag me af wat het voordeel is van het storen van data in een array en dan via batches toe te voegen aan de sheet. Doordat ScreenUpdating uitstaat vermoed ik al dat er niet veel performance loss is, maar ik weet het niet zeker.

@Roblll & farlane
Het is inderdaad een geval van not responding. Maar daar lijkt die dan ook niet meer uit te komen.

@Rannasha
Ik ga even kijken wat ik hiermee kan. Bedankt!

[Robertobananas]

Ik heb even verder zitten knutselen op basis van jullie feedback en ben hier op uit gekomen. Misschien staat nog niet alles netjes maar het werkt wel significant vlotter!

Visual Basic: TriangleNumbers

Sub Triangles3()

Dim divisors As Integer, number As Long, i As Long
Dim ws As Worksheet
Dim y As Long, x As Long
Dim Finder As Range
Dim TriNum As Long
Dim Div(1 To 2) As Long
Dim n As Long
Dim Total As Long

Application.ScreenUpdating = False

Set ws = ActiveWorkbook.Worksheets("Sheet3")
Set Finder = ws.Range("A:A").Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious, False)
y = Finder.Row + 1
TriNum = 1

Stop
Stop

'Tri
Do Until y = 20000 'divisors >= 500
TriNum = ((y - 1) * ((y - 1) + 1)) / 2
n = y - 1
ws.Cells(y, 1) = TriNum
    If n Mod 2 = 0 Then 'even number
        Total = n / 2
        For i = 1 To Total
        If Total Mod i = 0 Then Div(1) = Div(1) + 1
        Next
        Total = n + 1
        For i = 1 To Total
        If Total Mod i = 0 Then Div(2) = Div(2) + 1
        Next
        divisors = Div(1) * Div(2)
    Else 'odd number
        Total = n
        For i = 1 To Total
        If Total Mod i = 0 Then Div(1) = Div(1) + 1
        Next
        Total = (n + 1) / 2
        For i = 1 To Total
        If Total Mod i = 0 Then Div(2) = Div(2) + 1
        Next
        divisors = Div(1) * Div(2)
    End If
ws.Cells(y, 2) = divisors
    Div(1) = 0
    Div(2) = 0
    divisors = 0
divisors = 0
y = y + 1
Loop

MsgBox "DONE"
Application.ScreenUpdating = True

End Sub

Ik zie dat er nog wat 'foutjes' in staan maar ik ben aardig tevreden.
Bedankt voor alle hulp!