d7r5.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8400
   ClientLeft      =   1665
   ClientTop       =   345
   ClientWidth     =   7770
   LinkTopic       =   "Form1"
   ScaleHeight     =   8400
   ScaleWidth      =   7770
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   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 D7R5
    'for routine SORT2
    Dim A(100), B(100)
    Open "D:\VB常用数值算法集\DATA\TARRAY.DAT" For Input As #2
    For I = 1 To 10
        Line Input #2, dum$
        For J = 1 To 10
            A(10 * (I - 1) + J) = Val(Mid(dum$, 6 * J - 5, 6))
        Next J
    Next I
    Close (2)
    'Generate B-array
    For I = 1 To 100
        B(I) = I
    Next I
    'Sort A and mix B
    Call SORT2(100, A(), B())
    Print "After sorting A and mixing B, array A is:"
    For I = 1 To 10
        For J = 1 To 10
            Print Tab(7 * (J - 1) + 2); Format$(A(10 * (I - 1) + J), "###.#0");
        Next J
        Print
    Next I
    Print "...and array B is:"
    For I = 1 To 10
        For J = 1 To 10
            Print Tab(7 * (J - 1) + 2); Format$(B(10 * (I - 1) + J), "###.#0");
        Next J
        Print
    Next I
    MSG1$ = "press RETURN to continue..."
    X = MsgBox(MSG1$, 1)
    'Sort B and mix A
    Call SORT2(100, B(), A())
    Print "After sorted B and mixing A,array A is:"
    For I = 1 To 10
        For J = 1 To 10
            Print Tab(7 * (J - 1) + 2); Format$(A(10 * (I - 1) + J), "###.#0"); "  ";
        Next J
        Print
    Next I
    Print "...and array B is:"
    For I = 1 To 10
        For J = 1 To 10
            Print Tab(7 * (J - 1) + 2); Format$(B(10 * (I - 1) + J), "###.#0");
        Next J
        Print
    Next I
End Sub
Sub SORT2(N, RA(), RB())
    L = N / 2 + 1
    IR = N
    Do
        If L > 1 Then
            L = L - 1
            RRA = RA(L)
            RRB = RB(L)
        Else
            RRA = RA(IR)
            RRB = RB(IR)
            RA(IR) = RA(1)
            RB(IR) = RB(1)
            IR = IR - 1
            If IR = 1 Then
                RA(1) = RRA
                RB(1) = RRB
                Exit Sub
            End If
        End If
        I = L
        J = L + L
        While J <= IR
            If J <= IR Then
                If J < IR Then
                    If RA(J) < RA(J + 1) Then J = J + 1
                End If
                If RRA < RA(J) Then
                    RA(I) = RA(J)
                    RB(I) = RB(J)
                    I = J
                    J = J + J
                Else
                    J = IR + 1
                End If
            End If
        Wend
        RA(I) = RRA
        RB(I) = RRB
    Loop
End Sub