Random letter generator

  • Thread starter Thread starter Micheal Artindale
  • Start date Start date
M

Micheal Artindale

I am looking to create a spreadsheet that has random letter combinations
such that:
1) it can repeat itself,
2) the letter is never beside itself,
3) I can pick the letters,
4)I can pick the length of the combination

Any suggestions?

Thanks

Micheal
 
Micheal Artindale said:
I am looking to create a spreadsheet that has random letter
combinations such that:
1) it can repeat itself,
2) the letter is never beside itself,
3) I can pick the letters,
4) I can pick the length of the combination
Click to expand...
....

So #1 means ABC could appear multiple times, while #2 means AAB, ABB,
etc would never appear? If so, here's another udf solution.


Function foo(ca As String, n As Long) As String
Dim k As Long, p As Long, q As Long

'check for valid parameters
If ca = "" Or n < 1 Or (Len(ca) = 1 And n > 1) Then Exit Function

'prune any duplicates in ca
With Application.WorksheetFunction
For k = 1 To Len(ca) - 1
ca = Left$(ca, k) & _
.Substitute(Mid$(ca, k + 1), Mid$(ca, k, 1), "")
Next k
End With

k = Len(ca)

'recheck for valid parameters
If k = 1 And n > 1 Then Exit Function

For n = n To 1 Step -1
p = Int(k * Rnd + 1)
If p = q Then p = p Mod k + 1
foo = foo & Mid$(ca, p, 1)
q = p
Next n

End Function
 
Hello,

Harlan's code favours the i+1. char with double likelihood if i has
been chosen previously:
If you call foo("ABC",2), for example, then AB, BC and CA will appear
with likelihood 2/9 while AC, BA and CB will show up with only 1/9
likelihood.

This is just a "special form of randomness". If all but the previously
drawn char should appear with identical likelihood, you can use for
example:

Function RndStringNTWChar(s As String, n As Long) As String
'Create random string with non-twin characters.
's contains valid characters, n length of returned string.
Dim i As Long, j As Long, k As Long, m As Long

'Check for valid parameters
If s = "" Or n < 1 Or (Len(s) = 1 And n > 1) Then
RndStringNTWChar = CVErr(xlErrValue)
Exit Function
End If

'Prune any duplicates in s
i = 1
Do While i < Len(s)
s = Left$(s, i) & _
Application.WorksheetFunction.Substitute(Mid$(s, _
i + 1), Mid$(s, i, 1), "")
i = i + 1
Loop

i = Len(s)

'Recheck for valid parameters
If i = 1 And n > 1 Then
RndStringNTWChar = CVErr(xlErrValue)
Exit Function
End If

m = i
For n = n To 1 Step -1
j = Int(m * Rnd + 1)
If m <> i And j >= k Then j = j + 1
RndStringNTWChar = RndStringNTWChar & Mid$(s, j, 1)
k = j
m = i - 1
Next n

End Function

Regards,
Bernd
 
Bernd P said:
Harlan's code favours the i+1. char with double likelihood . . . ....
This is just a "special form of randomness". If all but the
previously drawn char should appear with identical likelihood, . . .
Click to expand...
....

I was trying to generate the entire result string in the loop. That
was a mistake.

Yet another version.


Function foo(ca As String, n As Long) As String
Dim k As Long, p As Long, q As Long

'check for valid parameters
If ca = "" Or n < 1 Or (Len(ca) = 1 And n > 1) Then Exit Function

'prune any duplicates in ca
With Application.WorksheetFunction
For k = 1 To Len(ca) - 1
ca = Left$(ca, k) & _
.Substitute(Mid$(ca, k + 1), Mid$(ca, k, 1), "")
Next k
End With

k = Len(ca)

'recheck for valid parameters
If k = 1 And n > 1 Then Exit Function

q = Int(k * Rnd + 1)
foo = Mid$(ca, q, 1)
k = k - 1

For n = n To 2 Step -1
p = Int(k * Rnd + 1)
q = IIf(p < q, p, p + 1)
foo = foo & Mid$(ca, q, 1)
Next n

End Function
 
Michael Bednarek said:
My solution removes the picked letter from the original string for
the next pick; the previously picked letter is then re-added to the
end of the string. The idea is that for a random pick the position
of the letters does not matter.
Click to expand...
....

Lack of randomness in my first udf was an error. I replied to Bernd P
with a fixed version.

VBA is generally inefficent with string processing, so I avoid it to
the extent I can. Thus only removing duplicate characters from the
string argument containing the possible characters.
 
Hello,

Another, more general UDF:

Function rl(s As String, n As Long) As Variant
'Create random string with non-twin characters.
's contains valid characters, n length of returned string.
'Repeating characters increase likelihood correspondingly,
'i.e. rl("AAB",1) will result in "A" with likelihood 2/3 and
'in "B" with likelihood 1/3
Dim i As Long, j As Long, k As Long, m As Long
Dim iarr(0 To 255) As Integer

'Check for valid parameters
If s = "" Or n < 1 Or (Len(s) = 1 And n > 1) Then
rl = CVErr(xlErrValue)
Exit Function
End If

For i = 1 To Len(s)
j = Asc(Mid(s, i, 1))
iarr(j) = iarr(j) + 1
Next i

j = Int(RandHistogrm(0#, 256#, iarr))
k = j 'store position
m = iarr(j) 'store likelihood
iarr(j) = 0 'avoid twin in next run
rl = Chr(j)

For i = 2 To n
j = Int(RandHistogrm(0#, 256#, iarr))
'http://www.sulprobil.com/html/histogrm.html
iarr(k) = m 'restore previous likelihood
k = j
m = iarr(j)
iarr(j) = 0
rl = rl & Chr(j)
Next i

End Function

Regards,
Bernd
 
Back
Top