Numbers to Lexicographic Index Number (CSN)

P

Paul Black

Hi everyone,

I have the code ...

Option Explicit

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim nVal As Double, nLex As Double

Sub LexToNumbers()
nVal = Range("A1").Value
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If nLex = nVal Then
Range("B1").Value = A
Range("C1").Value = B
Range("D1").Value = C
Range("E1").Value = D
Range("F1").Value = E
Range("G1").Value = F
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

.... which calculates and produces the 6 numbers associated with the
Lexicographic Index Number entered in cell "A1".
How can I get the Lexicographic Index Number from the numbers entered
in cells "B1:G1" please.
Tom Ogilvy produced the following code which might be of help :-

Function LexNumber()
LexNumber = False
a = IIf(44 - Range("O14").Value > 0, _
Application.Combin(49 - _
Range("O14").Value, 6), 0)
b = IIf(45 - Range("P14").Value > 0, _
Application.Combin(49 - _
Range("P14").Value, 5), 0)
c = IIf(46 - Range("Q14").Value > 0, _
Application.Combin(49 - _
Range("Q14").Value, 4), 0)
d = IIf(47 - Range("R14").Value > 0, _
Application.Combin(49 - _
Range("R14").Value, 3), 0)
e = IIf(48 - Range("S14").Value > 0, _
Application.Combin(49 - _
Range("S14").Value, 2), 0)
f = IIf(49 - Range("T14").Value > 0, _
Application.Combin(49 - _
Range("T14").Value, 1), 0)
lNumber = Application.Combin(49, 6) _
- a - b - c - d - e - f
If lNumber > 22500 And lNumber < 50000 Then
LexNumber = True
End if
End Function

Thanks in Advance.
All the Best.
Paul
 
P

p45cal

Function NumbersToLex()
A = IIf(44 - Range("B1").Value > 0, _
Application.Combin(49 - _
Range("O14").Value, 6), 0)
B = IIf(45 - Range("C1").Value > 0, _
Application.Combin(49 - _
Range("P14").Value, 5), 0)
C = IIf(46 - Range("D1").Value > 0, _
Application.Combin(49 - _
Range("Q14").Value, 4), 0)
D = IIf(47 - Range("E1").Value > 0, _
Application.Combin(49 - _
Range("R14").Value, 3), 0)
E = IIf(48 - Range("F1").Value > 0, _
Application.Combin(49 - _
Range("S14").Value, 2), 0)
F = IIf(49 - Range("G1").Value > 0, _
Application.Combin(49 - _
Range("T14").Value, 1), 0)
NumbersToLex = Application.Combin(49, 6) _
- A - B - C - D - E - F
End Function

seems to do it, use in a spreadsheet in any cell thus:
NumbersToLex()
I suspect the numbers will have to be in ascending order first though.
--
p45cal

ps. another longwinded way is to make small adjustments to your code:

Sub NumbersToLex2()
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If Range("B1").Value = A And Range("C1").Value = B And Range("D1").Value = C
And Range("E1").Value = D And Range("F1").Value = E And Range("G1").Value = F
Then
nVal = nLex
Range("H1") = nVal
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

I say long winded 'cos it could take a llllooonnnggg time.
p45cal
______
 
P

p45cal

a small mistake; I said:
use in a spreadsheet in any cell thus:
NumbersToLex()

it should have been:
use in a spreadsheet in any cell thus:
=NumbersToLex()
 
P

Paul Black

Thanks for the reply p45cal,

I really wanted it in a seperate sub so I could attach each of the
subs to a button please.

Thanks in Advance.
All the Best.
Paul
 
P

Paul Black

Thanks for the reply p45cal,

I really wanted the seperate sub which is great.
I put in numbers 44 45 46 47 48 49 and it took ages to calculate
13983816.
Is it quicker than calling the function from the sub, if so, how do I
do I call the function please?.

Thanks in Advance.
All the Best.
Paul
 
D

Dana DeLouis

I put in numbers 44 45 46 47 48 49 and it took ages to calculate
13983816.
Click to expand...

Hi. As a side note, in Combinations, what you are asking for is the Rank of
a Subset.
Your initial code "Sub LexToNumbers()" is trying to "UnRank" the subset.
Code is usually written much different than the above by taking advantage of
certain properties.
For example, the number 1 can only occur in so many subsets.
Search for something like "RankKSubset" where you must supply the initial
size of your array. (ie 49 as the first item)

t = Timer
Debug.Print RankKSubset(49, 44, 45, 46, 47, 48, 49)
Debug.Print Timer - t

returns
13983816
0 (ie seconds)
 
T

Tom Ogilvy

Sub NumbersToLex()
A = IIf(44 - Range("B1").Value > 0, _
Application.Combin(49 - _
Range("B1").Value, 6), 0)
B = IIf(45 - Range("C1").Value > 0, _
Application.Combin(49 - _
Range("C1").Value, 5), 0)
C = IIf(46 - Range("D1").Value > 0, _
Application.Combin(49 - _
Range("D1").Value, 4), 0)
D = IIf(47 - Range("E1").Value > 0, _
Application.Combin(49 - _
Range("E1").Value, 3), 0)
E = IIf(48 - Range("F1").Value > 0, _
Application.Combin(49 - _
Range("F1").Value, 2), 0)
F = IIf(49 - Range("G1").Value > 0, _
Application.Combin(49 - _
Range("G1").Value, 1), 0)
Range("A1") = Application.Combin(49, 6) _
- A - B - C - D - E - F
End Sub

was almost instantaneous for me.
 
P

Paul Black

Thanks everyone for your time and help, especially Tom, it works like
a dream.

All the Best.
Paul
 
P

p45cal

call the function in a sub thus:

Sub test()
Range("H1") = LexToNumber
End Sub

t-timer was zero here too Tom!
 
P

Paul Black

Thanks everyone for your time and help.
It all works great and VERY fast.
I went with Tom's sub in the end. One interesting point though, when I
"Dimmed" the variables it gave me an overflow 6 error.
Is there better coding for ...

Option Explicit

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim nVal As Double, nLex As Double

Sub LexToNumbers()
nVal = Range("A1").Value
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If nLex = nVal Then
Range("B1").Value = A
Range("C1").Value = B
Range("D1").Value = C
Range("E1").Value = D
Range("F1").Value = E
Range("G1").Value = F
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

.... to make it more efficient?.

Thanks in Advance.
All the Best.
Paul
 
D

Dana DeLouis

Hi. Just for Gee Wiz, here is something one would think Excel could not do.
Suppose you had a set of 300, instead of 49.
Suppose you also picked a random size of numbers, say 15.

{4, 15, 31, 53, 71, 80, 109, 122, 140, 152, 173, 175, 196, 198, 220}

Without changing the code, the above numbers are the
1,234,567,890,123,456,789,012,345
th item in the list.

Sub Demo()
Dim T
T = Timer
Debug.Print NF(RankKSubset(300, 4, 15, 31, 53, 71, 80, 109, 122, 140, 152,
173, 175, 196, 198, 220))
Debug.Print Timer - T
End Sub

Returns
1,234,567,890,123,456,789,012,345
0 (Seconds)

(Large number chosen for its pattern as a visual check)
Just a topic I find interesting. :>o
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Modify working code to expand the output. 5
Help with a Formula Within a Function Please 5
Code to insert a coma 26
For Eachcell in Range tranpose comma seperated values to a list in D 4
Copy Array to Array, how to and should I? 13
Count Specific Total Numbers from a Set 22
Loop thru xx No. of sheets until the four strValue combo's are found 6
Resize a row but copy but skip columns I don't want to copy 6

Top