d7r8.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7275
   ClientLeft      =   1860
   ClientTop       =   540
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   ScaleHeight     =   7275
   ScaleWidth      =   6975
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   5160
      TabIndex        =   0
      Top             =   6480
      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 D7R8
    'Driver for routine RANK
    Dim A(100), B(10), INDX(100), IRANK(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 (5)
    Call INDEXX(100, A(), INDX())
    Call RANK(100, INDX(), IRANK())
    Print "Original array:"
    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 "Table of ranks is:"
    For I = 1 To 10
        For J = 1 To 10
          Print Tab(7 * (J - 1) + 2); Format$(IRANK(10 * (I - 1) + J), "#####0");
        Next J
        Print
    Next I
    MSG1$ = "press RETURN to continue..."
    X = MsgBox(MSG1$, 1)
    Print "Array sorted according to rank table:"
    For I = 1 To 10
        For J = 1 To 10
            K = 10 * (I - 1) + J
            For L = 1 To 100
                If IRANK(L) = K Then B(J) = A(L)
            Next L
        Next J
        For J = 1 To 10
            Print Tab(7 * (J - 1) + 2); Format$(B(J), "##.#0"); "  ";
        Next J
        Print
    Next I
End Sub
Sub RANK(N, INDX(), IRANK())
    For J = 1 To N
        IRANK(INDX(J)) = J
    Next J
End Sub
Sub INDEXX(N, ARRIN(), INDX())
    For J = 1 To N
        INDX(J) = J
    Next J
    If N = 1 Then Exit Sub
    L = Int(N / 2 + 1)
    IR = N
    Do
      If L > 1 Then
          L = L - 1
          INDXT = INDX(L)
          Q = ARRIN(INDXT)
      Else
          INDXT = INDX(IR)
          Q = ARRIN(INDXT)
          INDX(IR) = INDX(1)
          IR = IR - 1
          If IR = 1 Then
              INDX(1) = INDXT
              Exit Sub
          End If
      End If
      I = L
      J = L + L
      While J <= IR
          If J < IR Then
            If ARRIN(INDX(J)) < ARRIN(INDX(J + 1)) Then J = J + 1
          End If
          If Q < ARRIN(INDX(J)) Then
            INDX(I) = INDX(J)
            I = J
            J = J + J
          Else
            J = IR + 1
          End If
      Wend
      INDX(I) = INDXT
    Loop
End Sub