d6r5.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5085
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5505
   LinkTopic       =   "Form1"
   ScaleHeight     =   5085
   ScaleWidth      =   5505
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   4440
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    'PROGRAM D6R5
    'Driver for routine EXPDEV
    NPTS = 10000: EE = 2.718281828
    Dim TRIG(21), X(21)
    For I = 1 To 21
        TRIG(I) = (I - 1) / 20#
        X(I) = 0#
    Next I
    IDUM& = -1
    For I = 1 To NPTS
        Y = EXPDEV(IDUM&)
        For J = 2 To 21
            If (Y < TRIG(J)) And (Y > TRIG(J - 1)) Then
                X(J) = X(J) + 1#
            End If
        Next J
    Next I
    TOTAL = 0#
    For I = 2 To 21
        TOTAL = TOTAL + X(I)
    Next I
    Print "Exponential distribution with "; NPTS; " points:"
    Print "      interval     observed    expected"
    For I = 2 To 21
        X(I) = X(I) / TOTAL
        EXPECT = Exp(-(TRIG(I - 1) + TRIG(I)) / 2#)
        EXPECT = EXPECT * 0.05 * EE / (EE - 1#)
        Print Tab(5); Format$(TRIG(I - 1), ".#0"); Tab(12); Format$(TRIG(I), ".#0");
        Print Tab(21); Format$(X(I), ".###0"); Tab(33); Format$(EXPECT, ".###0")
    Next I
End Sub
Function EXPDEV(IDUM&)
    DUM = 0!
    While DUM = 0!
        DUM = RAN1(IDUM&)
    Wend
    EXPDEV = -Log(DUM)
End Function
Static Function RAN1(IDUM&)
    Dim R(97)
    M1& = 259200: IA1& = 7141: IC1& = 54773: RM1 = 0.0000038580247
    M2& = 134456: IA2& = 8121: IC2& = 28411: RM2 = 0.0000074373773
    M3& = 243000: IA3& = 4561: IC3& = 51349
    If IDUM& < 0 Or IFF = 0 Then
        IFF = 1
        IX1& = (IC1& - IDUM&) Mod M1&
        IX1& = (IA1& * IX1& + IC1&) Mod M1&
        IX2& = IX1& Mod M2&
        IX1& = (IA1& * IX1& + IC1&) Mod M1&
        IX3& = IX1& Mod M3&
        For J = 1 To 97
            IX1& = (IA1& * IX1& + IC1&) Mod M1&
            IX2& = (IA2& * IX2& + IC2&) Mod M2&
            R(J) = (CSng(IX1&) + CSng(IX2&) * RM2) * RM1
        Next J
        IDUM& = 1
      End If
      IX1& = (IA1& * IX1& + IC1&) Mod M1&
      IX2& = (IA2& * IX2& + IC2&) Mod M2&
      IX3& = (IA3& * IX3& + IC3&) Mod M3&
      J = 1 + Int((97 * IX3&) / M3&)
      If J > 97 Or J < 1 Then Print "Abnormal exit": Exit Function
      RAN1 = R(J)
      R(J) = (CSng(IX1&) + CSng(IX2&) * RM2) * RM1
End Function