Solved

Shorter algorithm for number generator

Posted on 2002-07-15
51
216 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
  • 19
  • 11
  • 8
  • +5
51 Comments
 
LVL 43

Expert Comment

by:TimCottee
Comment Utility
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
Comment Utility
>TimCottee

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

Expert Comment

by:TimCottee
Comment Utility
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
 

Author Comment

by:afterburner
Comment Utility
>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
Comment Utility
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
Comment Utility
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
Comment Utility
The declaration is:

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

Author Comment

by:afterburner
Comment Utility
>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
Comment Utility
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
Comment Utility
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
Comment Utility
>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
Comment Utility
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
Comment Utility
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
Comment Utility
>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
Comment Utility
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
Comment Utility
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
Comment Utility
>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
Comment Utility
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
Comment Utility
egsemsem

better set IDigit to 16 as well .. ?
0
 

Author Comment

by:afterburner
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 18

Expert Comment

by:mdougan
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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 25 total points
Comment Utility
>"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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
I was robbed ... ;)
0
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
>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
Comment Utility
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
Comment Utility
Maybe i'll post it separately, thanks R.
0
 
LVL 18

Expert Comment

by:mdougan
Comment Utility
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
Comment Utility
>[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
Comment Utility
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
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…

771 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

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now