Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Shorter algorithm for number generator

Posted on 2002-07-15
51
Medium Priority
?
259 Views
Last Modified: 2010-05-18
This is just out of interest question: How short in terms of number of lines, can anyone produce a routine to count from, say 0, to, say 9999999999999999?

My VB routine is 16 lines long. Can anyone do it in less?
0
Comment
Question by:afterburner
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 19
  • 11
  • 8
  • +5
51 Comments
 
LVL 43

Expert Comment

by:TimCottee
ID: 7153901
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
0
 

Author Comment

by:afterburner
ID: 7153913
>TimCottee

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

Expert Comment

by:TimCottee
ID: 7153926
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.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:afterburner
ID: 7153963
>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.
0
 
LVL 18

Expert Comment

by:deighton
ID: 7154005
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
0
 
LVL 1

Expert Comment

by:slavikn
ID: 7154042
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!
0
 
LVL 1

Expert Comment

by:slavikn
ID: 7154054
The declaration is:

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

Author Comment

by:afterburner
ID: 7154200
>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.
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7154288
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
0
 

Author Comment

by:afterburner
ID: 7154335
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.
0
 

Author Comment

by:afterburner
ID: 7154344
>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. ;)
0
 
LVL 2

Expert Comment

by:ventond
ID: 7154449
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.
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 7154503
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
0
 

Author Comment

by:afterburner
ID: 7154793
>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.
0
 
LVL 2

Expert Comment

by:egsemsem
ID: 7154987
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
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155075
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
0
 

Author Comment

by:afterburner
ID: 7155091
>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 ...
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7155092
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.....

0
 

Author Comment

by:afterburner
ID: 7155104
egsemsem

better set IDigit to 16 as well .. ?
0
 

Author Comment

by:afterburner
ID: 7155166
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.
0
 
LVL 2

Expert Comment

by:egsemsem
ID: 7155170
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

0
 
LVL 18

Expert Comment

by:mdougan
ID: 7155185
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 ;)

0
 

Author Comment

by:afterburner
ID: 7155211
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
0
 

Author Comment

by:afterburner
ID: 7155235
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? :))
0
 
LVL 2

Expert Comment

by:egsemsem
ID: 7155310
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
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7155318
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155353
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155380
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
0
 
LVL 2

Expert Comment

by:egsemsem
ID: 7155522
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
0
 

Author Comment

by:afterburner
ID: 7155555
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.
0
 
LVL 22

Accepted Solution

by:
rspahitz earned 100 total points
ID: 7155577
>"GoTo again"

Well, that's one way to handle recursion.  I chose to use a separate subroutine.

FYI, using base 3, my "string addition" program, after about 1-1/2 hours, is up to number 212021101200102011, which seems to exceed the length of the 9999999999999999 mentioned in your question.

It seems that there are lots of interesting answers, but all except yours and mine seem to rely on adding or comparing numbers (well, we actually both add one somewhere and compare against 9, but otherwise, we never have to worry about overflow.)  Your limit is hardcoded based on the variable num; mine is dynamically built and can therefore go on as long as memory exists for the routine to contine.

--
As I wrote this, the number bumped up to 1000000000000000000, which I guess is 1,000,000,000,000,000,000 or 1 quintillion in base 3.  This would take a long time in base 10.


--
Thanks for a fun challenge!
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7155582
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155591
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.
0
 

Author Comment

by:afterburner
ID: 7155604
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155623
Thanks again.


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

Author Comment

by:afterburner
ID: 7155704
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?
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155776
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.
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7155784
I was robbed ... ;)
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7155798
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!)
0
 
LVL 2

Expert Comment

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

0
 
LVL 18

Expert Comment

by:mdougan
ID: 7156883
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!
0
 
LVL 18

Expert Comment

by:deighton
ID: 7157142
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
0
 

Author Comment

by:afterburner
ID: 7157417
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?
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7157442
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.
0
 

Author Comment

by:afterburner
ID: 7157489
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



0
 

Author Comment

by:afterburner
ID: 7157503
>Val(Mid(x, c, 1)) always get the value of a single digit.

I think I was getting confused with egsemsem's code.
0
 
LVL 22

Expert Comment

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

Author Comment

by:afterburner
ID: 7157584
Maybe i'll post it separately, thanks R.
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7158391
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
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 7158413
>[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.
0
 

Author Comment

by:afterburner
ID: 7159132
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 ...
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question