83 lines
1.6 KiB
Text
83 lines
1.6 KiB
Text
Const As Long RAND_MAX = 32767
|
|
Const ALFA = "+.ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
|
|
Const ALEN = Len(ALFA) - 3
|
|
|
|
Dim Shared As Integer grid()
|
|
Dim Shared As Integer w, ww
|
|
|
|
Sub makeGrid(p As Single)
|
|
Dim As Long thresh, r
|
|
thresh = Int(p * RAND_MAX)
|
|
|
|
ww = w * w
|
|
Redim grid(ww - 1)
|
|
|
|
For i As Integer = ww - 1 To 0 Step -1
|
|
r = Int(Rnd * (RAND_MAX + 1))
|
|
grid(i) = Iif(r < thresh, -1, 0)
|
|
Next
|
|
End Sub
|
|
|
|
Sub showCluster()
|
|
Dim As Integer k, i, j, s
|
|
Dim As String c
|
|
|
|
k = 0
|
|
For i = 0 To w - 1
|
|
For j = 0 To w - 1
|
|
s = grid(k)
|
|
k += 1
|
|
c = Iif(s < ALEN, Mid(ALFA, 1 + s + 1, 1), "?")
|
|
Print " " & c;
|
|
Next
|
|
Print
|
|
Next
|
|
End Sub
|
|
|
|
Sub recur(x As Integer, v As Integer)
|
|
If x >= 0 Andalso x < ww Andalso grid(x) = -1 Then
|
|
grid(x) = v
|
|
recur(x - w, v)
|
|
recur(x - 1, v)
|
|
recur(x + 1, v)
|
|
recur(x + w, v)
|
|
End If
|
|
End Sub
|
|
|
|
Function countClusters() As Integer
|
|
Dim As Integer ccl, i
|
|
|
|
ccl = 0
|
|
For i = 0 To ww - 1
|
|
If grid(i) = -1 Then
|
|
ccl += 1
|
|
recur(i, ccl)
|
|
End If
|
|
Next
|
|
Return ccl
|
|
End Function
|
|
|
|
Function tests(n As Integer, p As Single) As Single
|
|
Dim k As Single = 0
|
|
For i As Integer = 0 To n - 1
|
|
makeGrid(p)
|
|
k += countClusters() / ww
|
|
Next
|
|
Return k / n
|
|
End Function
|
|
|
|
' Main program
|
|
Randomize Timer
|
|
w = 15
|
|
makeGrid(0.5)
|
|
Print "width = 15, p = 0.5, " & countClusters() & " clusters:"
|
|
showCluster()
|
|
|
|
Print !"\np = 0.5, iter = 5:"
|
|
w = 4
|
|
While w <= 8192
|
|
Print Using "##### #.######"; w; tests(5, 0.5)
|
|
w Shl= 1
|
|
Wend
|
|
|
|
Sleep
|