⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 distribution types.bas

📁 this control is used for the programming with mapobject in the environment of Visual basic.
💻 BAS
字号:
Attribute VB_Name = "Module2"
'Option Explicit
Option Base 1
Public Const PI As Single = 3.141592654


Public X0 As Single, Y0 As Single       'Define coordinates of the starting point
Public X1 As Single, Y1 As Single       'Define the coordinates ending point
Public TreeHeight() As Single           'store tree height values
Public TreeNo As Long                   'Total tree number for the test area
Public X() As Single, Y() As Single     'Coordinates of objects of interest
Public Bufferwidth As Single            'Set bufferwidth to avoid edge effect

Public DistributionType As Integer      'store the distribution type of DBHs
Public Const Normal = 0
Public Const Exponential = 1
Public Const Geometric = 2

Public DBH() As Single                  'DBH values of all individuals in the study area
Public Dmax As Single                   'Store the maximum value of DBH
Public Dmin As Single                   'Store the minimum value of DBH
Public Dmean As Single                  'define the mean DBH of study area
Public Dstdev As Single                 'define standard deviation of DBHs
Public BA() As Single                     'define the Basal Area

Public Lambda1 As Integer                'Argument passed to Poisson Variate Generation Procedure
Public Lambda2 As Integer                'Argument passed to Poisson Variate Generation Procedure
Public Lambda3 As Integer                'Argument passed to Exponential Variate Generation Procedure

'The data type of all Lambdas should be the same as the one in the function of Poissonrand.
'Otherwise a type mismatch error will occur.


'********************************************************************************************************
'* Declare variable for Poisson Cluster Process                                                         *
'*                                                                                                      *
'* Number of clusters from Poisson distribution with mean M1                                            *
'* Cluster centers randomly located in the grid                                                         *
'*                                                                                                      *
'* Number of individuals per cluster from Poisson distribution with mean M2                             *
'* Distance between object of interest and cluster center from exponential distribution with mean M3    *
'* Angle ranges from 0-360 degree                                                                       *
'********************************************************************************************************

Public NOC As Long              'Define Number of clusters
'Public NOI As Long              'Define Number of Individuals in a cluster

'Simulate Poisson distributed random variates with parameter lambda

Public Function poissonrand(lambda As Integer)
Dim i As Integer
Dim p As Double
Dim f As Double
Randomize
U = Rnd
p = Exp(-lambda)
f = p

prg: If U < f Then
        rx = i
        poissonrand = rx
    Else
        p = lambda * p / (i + 1)
        f = f + p
        i = i + 1
        GoTo prg
    End If
End Function

'Generating exponential random variates

Public Function exprand(lambda As Single) As Double
Randomize
Dim U As Double
U = Rnd
exprand = -Log(U) / lambda
End Function

'Generating normal distributed random variates
Function Normrand(Optional Mean As Single, Optional Std As Single)
Const PI As Double = 3.141592654                                'This is PI a constant
Dim V1 As Double, V2 As Double, X As Double
                                                                'Draw random number from a normal distribution
                                                                'with a Mean and Std.
If Std = 0 Then Std = 1
Do
V1 = Rnd()
V2 = Rnd()
Loop Until V1 > 0 'avoid negative value in logarithm
X = Sqr(-2 * Log(V1)) * Cos(2 * PI * V2)
Normrand = Mean + Std * X
End Function

'Layout the generated data
Public Sub Graph()
Frm_Display.Pic_layout.Cls
Frm_Display.Pic_layout.Scale (0, Y1)-(X1, 0)
Dim i As Long
For i = 1 To TreeNo
Frm_Display.Pic_layout.PSet (X(i), Y(i)) ', Damagecolor(i) 'Speciescolor(i)    'IIf(species(i) = 1, vbBlue, vbRed)
Next i
Frm_Display.Pic_layout.Line (Bufferwidth, Y1 - Bufferwidth)-(X1 - Bufferwidth, Bufferwidth), vbRed, B
End Sub

Public Sub Writexy2Datagrid()
With Frm_Display.Datagrid
Dim i As Long
    For i = 1 To TreeNo
        .TextMatrix(i, 0) = i
        .TextMatrix(i, 1) = Round(X(i), 2)
        .TextMatrix(i, 2) = Round(Y(i), 2)
        .TextMatrix(i, 3) = Round(DBH(i), 1)
        .TextMatrix(i, 4) = Round(BA(i), 2)
    Next i
End With
End Sub

'Function used to check whether a tree is within sample plot

Public Function Distance(i As Long, j As Long) As Single 'check the distance between each another.
Dim dx As Single, dy As Single
dx = X(i) - X(j)
dy = Y(i) - Y(j)
Distance = Sqr(dx ^ 2 + dy ^ 2)
End Function

'Generate Tree DBH
Public Sub Generate_DBH()
    ReDim DBH(TreeNo)
        For i = 1 To TreeNo
            Do
            DBH(i) = Normrand(Dmean, Dstdev)
            Loop Until DBH(i) > 0 And DBH(i) < Dmax
        Next i

End Sub

'Calculate individual basal area
Public Sub Generate_BA()
    ReDim BA(TreeNo)
        For i = 1 To TreeNo
            BA(i) = PI * (DBH(i) ^ 2) / 4
        Next i

End Sub



'Extract number out of a string

Public Function ExtrNo(Instring As String)
    Dim i As Integer
    Dim Outstring As String
    For i = 1 To Len(Instring)
        Select Case Mid(Instring, i, 1)
            Case "0" To "9"
                Outstring = Outstring + Mid(Instring, i, 1)
        End Select
    Next i
    
    ExtrNo = Val(Outstring)
    
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -