Shorter algorithm for number generator

Well a for next loop will do it in 2, 3 if you want to actually print it to the IDE, 4 if you want to display on a label, 5 with the declare statement.

Dim i As Long
For i = 0 To 99999999999999
  Label1.Caption = i
  DoEvents
Next

>TimCottee

A long is only four bytes taking it to 2,147,483,647. :)

Then  use an 8 byte double instead. This will handle numbers of the order of -1.79769313486231E308 to
-4.94065645841247E-324 for negative values; 4.94065645841247E-324 to 1.79769313486232E308 for positive values which is sufficient for your value.

>TimCottee

Private Sub Command1_Click()
Dim num, i As Double
num = 1E+307
For i = num To num * 2
 Label1.Caption = i
 DoEvents
Next
End Sub

1: No label display change, as number in sci format.
2: Overflow eventually, esp. when starting number is near limit.

Private Sub Form_Load()

Dim x As String
Dim lCarry As Long
Dim c As Long
Dim lDigit As Long
Dim lVal As Long

lDigit = 16

x = String(lDigit, "0")

Debug.Print x
Do Until x = String(lDigit, "9")

    lCarry = 0
    For c = lDigit To 1 Step -1
        lVal = Val(Mid(x, c, 1)) + lCarry - (c = lDigit)
        lCarry = -(lVal >= 10)
        Mid(x, c, 1) = CStr(lVal Mod 10)
    Next
   
    Debug.Print x
   
Loop

   



End Sub

afterburner,

Why do you need to count? Do you want to stop the running for a while? Use the Sleep API.

Sleep(10000) ' This will wait 10 seconds and then will continue.

PLAESE ACCPET IF THIS HELPED!

The declaration is:

Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

>deighton

Wha-hey; that's more what I was looking for. Reckon your code is also 16 lines.

slavikin: no idea what you are talking about.

Since you specified number of lines, instead of number of instructions, I can name that tune in one line:

For i = 0 To 1E+16: Label1.Caption = i: Label1.Refresh: Next

deighton:

Interesting approach. Quite a handful in terms of pathology your algorithm. It appears a bit wasteful in three areas if I'm not mistaken: ICarry never needs to be a Long and not does IVal, since the former is really only a numeric value for true and false, and the latter can never be more than 10. Also, you process each position in the number string in your for next loop, but you know that nothing is going to happen in any position unless it has already reached 9. So there is a lot of redundant cycles here, since there is mostly nothing to calculate.

The way you use booleans to act as the carry values is pretty cute, but of course it wont do a lot of good on any systems which return any non-negative values for boolean Trues - it looks like the algorithm would fall over badly.

I'll put my code up later for fun and for anyone's comments, but wait to see if anyone else has any ideas for a while first.

>Since you specified number of lines, instead of number of instructions, I can name that tune in one line:

Very funny; but it's still got to work. See comments to TimCoffee above. ;)

dim ndx as long
dim ndx2 as long
for ndx = 0 to 99999999
for ndx2 = 0 to 99999999
label1.caption = format$(ndx,"00000000") & format$(ndx2,"00000000")
doevents
next ndx2
next ndx


Not pretty and not particularly fast.

Another possibility:

    Dim i As Variant
    For i = 0 To 100000000# Step 0.00000001
        Label1.Caption = Replace(CStr(Int(i)) & CStr(Int((i - Int(i)) * 100000000#)), ".", "")
        DoEvents
    Next

>Not pretty and not particularly fast.

Seems quick; beauty is in the simplicity itself. Beats 16 lines, but presumably need to add an additional for ... next loop for each Long, so your code would be ahead until we deal with 60 digit numbers?

>Another possibility:

Cool, small, effective. Runs into theoretical upper Variant limit though, like a Long; and pity the Replace function aint in VB.

A more enhanced algorithm built on deighton's approach :

Dim x As String
Dim pos As Integer
Dim lDigit As Integer

pos = 16 - 1
 
x = String(lDigit, "0")

Do Until x = String(lDigit, "9")
   
   If Len(Right(x, lDigit - pos)) = Len(CStr(Val(Right(x, lDigit - pos)) + 1)) Then
    x = String(pos, "0") & CStr(Val(Right(x, lDigit - pos)) + 1)
   Else
    x = String(pos - 1, "0") & CStr(Val(Right(x, lDigit - pos)) + 1)
    pos = pos - 1
   End If
   
   Debug.Print x
   
Loop



Osama

So, are you looking for code that will count to infinity and be able to do the counting (assuming that memory is not an issue)?

I suppose the answer is to store the current number in a string, then increment the right-most digit until it reaches 10 (an overflow), after which, replace it with zero, and recurse through the next higher digit until the overflow is zero.

Also, all of the above answers can be written in one line such as:

dim ndx as long, ndx2 as long:for ndx = 0 to 99999999:for ndx2 = 0 to 99999999:label1.caption = format$(ndx,"00000000") & format$(ndx2,"00000000"):doevents:next ndx2:next ndx

>Also, all of the above answers can be written in one line such as:

...thought we already covered that? As for the for next loops ... dont you always have to keep adding these to the code when each Long expires? If so, that is the least elegant solution so far ...

I didn't see anything in Tim's posts that should concern my code.  I'm testing it now to verify it.  The variant data type *should* be able to cast to a data type that can hold that large of value.  It make take me a while to count that high though.....

egsemsem

better set IDigit to 16 as well .. ?

egsemsem:

Your code says smthg like "if adding one to the value of the xth righthand set of digits from the number still fits into the number of positions required to display that new value, then make a string with leading zeros of the length of the original string minus the number of places needed for the new value and prepend it to a cstr of the new value; otherwise do the same thing but with one less leading zero."

That's the best contribution yet IMHO.

The multiloops problem in ventond's comment can be solved simply by using recurrsion technique (8 lines of code only !):

The main function is:

Function SmartEnu(UpLim As String, Pos As Integer, CurrNum As String)
    Dim i As Long
    Do While (i <= 99999999 And CStr(CurrNum & CStr(i)) <> UpLim)
        i = i + 1
        If Len(UpLim) > Pos * 8 Then SmartEnu UpLim, Pos + 1, CurrNum & CStr(i) Else Debug.Print CurrNum & CStr(i)
    Loop
End Function

And the line that will call this function is:

SmartEnu "9999999999999999", 1, ""

where "9999999999999999" is the upper limit, choose any number you want ;)


cheers,

Osama

Of course, you also didn't specify the increment, so, technically the code below would qualify as both the least number of lines and the fastest.

For i = 0 To 9999999999999999 step 9999999999999999: Label1.Caption = i: Label1.Refresh: Next

By the way, seeing how long it's taking to test my previous example, I KNOW you're not testing each comment to see if they work ;)

egsemsem

That's pretty good too. Recursion is nice stuff.

Your last contribution wont suffer overflow, but of course this one would if :

>SmartEnu(1E+309, 1, "").

Thanks

mdougan

I am probably not following your line of thought, and that's my stupid fault of course, but my original point was that whatever type your "i" is it will run out of maths space sooner than a string.

As to the step, well it goes without saying that it gets incremented by ONE each time. You aren't taking this very seriously are you?! :/

And I have tested each and every contribution. Do you think someone like me has a real job or home to go to? :))

afterburner , my function accepts the upper limit as a string, you can't write SmartEnu(1E+309, 1, ""), instead you should write 1E+309 as real digits in "" .

Osama

Since i isn't dimed anywhere, it will get a default data type of variant.  Generally VB is smart enough to look at a statement and pick the appropriate underlying variant type when instantiating the variable i.  Given that the numeric constant 9999999999999999 is in the For statement, then VB "should" cast the i as a variant datatype that can hold a number of that size.  So, I don't expect it to run out of storage space.  But, assumptions usually kill you, so, I'm running a test.  

However, since my test has been running for a few hours now, and I'm only in the 80 millions, I have to doubt that you've tested any solution up to the 10 quadrillion (or whatever it may be called) mark (though if you didn't display each count, it would run a lot faster).

As far as the increments, I'm just being literal.  Coding is very literal.  I'm just pointing out the vagueness of the requirements definition <g>

Still, at one line and four statements, I think I'm winning in the brevity department.

OK, since I mentioned the string stuff, here's my answer (and the idea of 16 lines is arguable since Dims are not really lines, Sub/End Sub are sub structures, etc.)

This code should, theoretically, count forever (given enough memory) and can count in any base value defined in mcUpperLimit (from base 2 [value=1] to base 10 [value=9].)

First, add a label, Label1 to disply the current value.  Then add three command buttons: cmdStart, cmdPause, cmdStop.

Finally add this code:

Option Explicit

Private mstrCounter As String
Private Const mcUpperLimit = 1
Private mbStopRequested As Boolean
Private mbPauseRequested As Boolean

Private Sub cmdStart_Click()
  mbStopRequested = False
  If Not mbPauseRequested Then
1    mstrCounter = "0"
  End If
  mbPauseRequested = False
 
2  Do Until mbStopRequested Or mbPauseRequested
3    IncrementNumber 1
4    Label1.Caption = mstrCounter
    DoEvents
5  Loop
End Sub

Private Sub IncrementNumber(ColumnNumber As Integer)
  Dim strDigit As String
  Dim iRealColumnNumber As Integer
 
6  If ColumnNumber > Len(mstrCounter) Then
    ' add leading zero placehold to handle the carry-digit
    mstrCounter = String$(ColumnNumber - Len(mstrCounter), "0") & mstrCounter
  End If
 
7  iRealColumnNumber = Len(mstrCounter) - ColumnNumber + 1
 
8  strDigit = Mid$(mstrCounter, iRealColumnNumber, 1)
9  If Val(strDigit) < mcUpperLimit Then
10    Mid$(mstrCounter, iRealColumnNumber, 1) = (Val(strDigit) + 1) & ""
11  Else
    ' Reset column to zero
12    Mid$(mstrCounter, iRealColumnNumber, 1) = "0"
    ' Carry the one
13    IncrementNumber ColumnNumber + 1
14  End If
End Sub

Private Sub cmdStop_Click()
  mbStopRequested = True
End Sub

Private Sub cmdPause_Click()
  mbPauseRequested = True
End Sub

Private Sub Form_Load()
  mbPauseRequested = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  mbStopRequested = True
End Sub

-----
I currently have it set to display binary, but can certainly display decimal.

Do I win?  I came up with 14 logical lines (where the IF statements are combined into one) and line 9 could be duplicated since it's just a temproary value, and likewise with line 10, although that interim value is used to create another interim value so it seems to make sense there.  I also counted the ELSE and ENDIF because I didn't want to use the multi-line structure.  I also did not count the boolean values that allow you to stop the app since they are just interfaace variables.

Oh, another way to pause it to click-and-hold on the titlebar.

Just modified this to improve speed:

Private Sub cmdStart_Click()
  Dim i As Integer
  mbStopRequested = False
  If Not mbPauseRequested Then
    mstrCounter = "0"
  End If
  mbPauseRequested = False
 
  i = 0
  Do Until mbStopRequested Or mbPauseRequested
    IncrementNumber 1
    i = i + 1
    If i > 5000 Then
      Label1.Caption = mstrCounter
      i = 0
    End If
    DoEvents
  Loop
End Sub

afterburner, it seems you have a real job or home to go to :))
If you have tested my code, you will have found that it doesn't work properly, however, here is the function after fixing it:


Function SmartEnu(UpLim As String, Pos As Integer, CurrNum As String)
   Dim i As Long
   Do While (i <= 99999999 And CStr(CurrNum & CStr(i)) <> UpLim)
    If Len(UpLim) > Pos * 8 Then SmartEnu UpLim, Pos + 1, CurrNum & IIf(CurrNum = "" Or CurrNum = String((Pos - 1) * 8, "0"), CStr(i), CStr(Format(i, "00000000"))) Else Label1 = CurrNum & IIf(CurrNum = "" Or CurrNum = String((Pos - 1) * 8, "0"), CStr(i), CStr(Format(i, "00000000"))): DoEvents
    i = i + 1
   Loop
End Function

Osama

Well after all that fun, here's my own highly boring alternative:

Dim num As String
Dim marker As Integer
num = "0000000000000000" 'or whatever you like
marker = Len(num)


Do While num <> string(len(num),"9")
again:

    If Mid(num, marker, 1) <> "9" Then
Mid(num, marker, 1) = Trim(Str(Val(Mid(num, marker, 1)) + 1))
        marker = Len(num)
        Label1.caption = num
       
    Else
        Mid(num, marker, 1) = "0"
        marker = marker - 1
        GoTo again:
    End If


Loop


I reckon it would take about 40,000 years to shuffle through the puny 16 digit number on my P2.

I eliminated the lable caption assignment and refresh (for sake of speed), and added a msgbox at the end:

For i = 0 To 1E+16: Next: msgbox i

And, I'm up to about 59 billion and counting (so, I'm well above the Long overflow)

Still by far the most concise solution.

Hmmm...after review of your code, I see that your 16 lines includes the dim and the optional "marker" assignment.

All this goes to show that it's not size (of your code) that matters, it's the quality of your output!  (Although maybe mdougan offers both?)

P.S.
I'll bet someone could write some assembler code--maybe about 10 lines--that would simply keep incrementing a memory block with little regard to the memory limitations, and could not only beat the above answers, but also have great speed.  The challenge would be to display it.

I think I have to give the points to rspahitz since he introduced another dimension to the question, and underlined the overflow dilemma. He also thanked me, which clinched the deal.

Bye everyone, and thanks for helping me waste my day.

Thanks again.


Now...who can write the *fastest* VB code to count to 1,000,000,000,000,000? (I abstain.)

As a total afterthought: if such a fast algorithm could be written as you say, and alloyed to a checksum algorithm such as that used to qualify credit card numbers, would this combination have any implications for 128 bit encryption integrity at all?

From what I hear, 128-bit encryption deals with multi-billion combinations.

The above referred to routine would still take a long time to get to 1 quadrillion.  Then, for each of those, it would have to perform a decryption routine which would significantly slow it down.  This is why distributed processing becomes important for breaking such codes--multiple machines can be working on different blocks of the process simultaneously.  Of course, if people really want your credit card number, there are easier ways...like call you up and tell you that you've won a fabulous 2-week vacation...just leave your credit card number as a verification.  I don't know how many people fall for this now, but it used to be pretty common; of course, the schuysters simply change the wording or the theme and pull it off anyway.

Personally, I don't like to deliver my card/ID numbers across any medium which might be insecure, with the exception of the telephone and trustworthy SSL sites ... and even that I'm leary about and won't do it unless I initiated the call.

I was robbed ... ;)

Hey...just 'cause I'm a "Rob" doesn't make me a "Robber"!

And besides, your code has an inherent flaw.  I modified it to this:

Private Sub Command1_Click()
  Dim i As Variant
 For i = 0 To 1E+16 Step 10000000000000#
  Label1.Caption = i
  Label1.Refresh
Next

End Sub

and when it exceeds 1E15 minus 1 it changes format to 1E15 then 1.01E15 ... and ends with 1E16 in the display area.  I suspect that this would lose resolution at higher values, like 1E50 and could then get stuck in an endless loop while it adds the number one to something which doesn't have the resolution to add one.

But you're right that the variant concept actually works well here (and should be much faster than my string solution)...but may "break" in .net since variants become objects? (Or maybe it will make it work even better!)

Thank u you all for this useful discussion. But I still can't understand what is wrong with my algorithm.

Thanks rspahitz, for the tip.  After running all night I'm only up to 689 Billion.  I think it would be a while until I hit that point incrementing by one.  

I'd like to see the error that you point out when incrementing by one, so maybe I'll restart at 1E16 - 5 and step through it.  Cheers!

some points here afterburner, my first coding didn't need the lcarry variable at all, I optimised it to this now


Private Sub Form_Load()

Dim x As String
Dim c As Long
Dim lDigit As Long


lDigit = 16

x = String(lDigit, "0")

Debug.Print x
Do Until x = String(lDigit, "9")
   
   For c = lDigit To 1 Step -1
       Mid(x, c, 1) = CStr((Val(Mid(x, c, 1)) - (c = lDigit) + IIf(Mid(x, c + 1, 1) = "0", 1, 0)) Mod 10)
       If Mid(x, c, 1) <> "0" Then Exit For
   Next
   
   Debug.Print x
   
Loop

End Sub

, the - (c=16) trick won't work in .net I believe since true will be 1 (suppose - will just be + though), but you can always use IIF.

I like the boolean method myself, adds a bit of confusion

deighton

i like your boolean method better too. Anyway, wont your val() function eventually go the way of all numbers in this 'ere issue?

BTW: Anyone likely to know what the meaning of RHS is in VB assignments by chance?

Val(Mid(x, c, 1)) always get the value of a single digit.

RHS?  Sure, I'll byte...what's the context and what's the meaning.

rspahitz

i'll put some more points up if you want, let me know. All I want to know is about the following example:

Public Property Let MainDB(RHS As String)
    mstrMainDB = RHS
End Property

>Val(Mid(x, c, 1)) always get the value of a single digit.

I think I was getting confused with egsemsem's code.

No points...I've seen RHS stand for Right-Hand-Side, but I'm not sure if it's the same in this context.

Maybe i'll post it separately, thanks R.

I believe that RHS stands for Right-Hand-Side, my guess, since it's a Let statement, that it's self-documentation for:

myobj.MainDB = RHS value

The RHS value would be the parm passed to the Let statement for the property MainDB

>[RHS] it's self-documentation

Some people' idea of documentation is a joke.  It would be clearer to just use the generic word "value" like the MS Class-builder does.

But I think you're right, now that I see the explanation.

rspahitz and mdougan:

got to the bottom of RHS. In calling code, you make an assignment such as: newobj.MainDB = "Hello world".

Over in the Property Let, Set and Get pseudo-functions, the Let function sees this call, and takes the RHS of the calling assignment (Hello World). Then whenever you need the value of the property MainDB, you call the Get pseudo-function like : mystring = newobj.MainDB, and you end up with the mystring variable being equal to Hello World in your calling code.

Whooo ...