Can you call and calculate OPR using vb.net

Im using Visual Studio 2012 for a scouting program, and I was just wondering if and how to calculate and show the OPR like this.

Here’s the “formula” for OPR:

I can walk you through it if you’re determined.

I have VB.NET code from Visual Studios 2008 for OPR calculations. I also have Java and VBA as well. When I get home I will see if I can load the method onto this thread…

That would be amazing.

While we’re waiting, what numerical solution method did you use? e.g. SVD, QR, LU, Cholesky, Matrix inversion, etc ?

Yes, That is where I got lost.

The choice of numerical algorithm can make the difference between 5 minutes of computation vs 12 seconds.

I know how to gather the data under vb.net, but I don’t know how to solve the matrix.

Are you trying to solve the overdetermined matrix or the normal matrix?

I had a bad algebra II teacher. So, I don’t even know how to breakdown a normal matrix.

Here is my code. Sorry if it doesnt make sense. I wrote it for personal use and wasn’t expecting to post it. If you need clarification on anything, go ahead and ask. I did use some external functions for the matrix calculations.

Some background info about what it does though:

It reads a text file called ‘OriginalFileInfo.Text’. This file is organized as such:
Blue1
Blue2
Blue3
BlueScore
Red1
Red2
Red3
RedScore
Blue1
Blue2
etc…

It then outputs a file to ‘OPR.Text’

Here is the code:

Imports System.IO
Imports System.Threading

Module Module1

    Sub Main()
        Call RetrieveData()
        Dim matrixA(,) As Double = MatrixHelper.Inverse(intOPRArray)
        Dim matrixB() As Double = MatrixHelper.Multiply(matrixA, intTeamsScore)
        Call WriteFile(intTeams, matrixB)
        Console.WriteLine(MatrixHelper.MakeDisplayable(matrixB))
    End Sub

    Dim intOriginalFileInfo() As Integer
    Dim intOPRArray(,) As Double
    Dim intTeams() As Integer
    Dim intBlueTeams(,) As Integer
    Dim intRedTeams(,) As Integer
    Dim intBlueScore() As Integer
    Dim intRedScore() As Integer
    Dim intTeamsScore() As Double

    Sub RetrieveData()
        Dim FilePathName As String = My.Application.Info.DirectoryPath & "\OriginalFileInfo.Text"
        Dim HighScoreFile As New FileInfo(FilePathName)
        If HighScoreFile.Exists = False Then
            Console.WriteLine("Please Create the Text File to be read.")
            Console.WriteLine(FilePathName)
            System.Threading.Thread.Sleep(5000)
        Else
            Dim inFile As System.IO.FileStream
            inFile = New System.IO.FileStream(FilePathName, IO.FileMode.Open, IO.FileAccess.Read)
            Dim fileReader As New System.IO.StreamReader(inFile)
            Dim intCounter As Integer = 0
            Dim intTempItem As Integer

            'Read the raw data file and put it into intOriginalFileInfo array
            Do While fileReader.Peek > -1
                intTempItem = Val(fileReader.ReadLine)
                ReDim Preserve intOriginalFileInfo(intCounter)
                intOriginalFileInfo(intCounter) = intTempItem
                intCounter += 1
            Loop
            fileReader.Close()
            inFile.Close()
            Console.WriteLine("Reading File")

            'ReInitialize the arrays that hold the blue/red teams and score
            ReDim intBlueTeams((intOriginalFileInfo.Length \ 8) - 1, 2)
            ReDim intRedTeams((intOriginalFileInfo.Length \ 8) - 1, 2)
            ReDim intBlueScore(intOriginalFileInfo.Length \ 8 - 1)
            ReDim intRedScore(intOriginalFileInfo.Length \ 8 - 1)

            'Populate the Blue/Red Teams/Score Arrays
            For intSlotCounter As Integer = 0 To intOriginalFileInfo.Length - 1
                Select Case (intSlotCounter Mod 8)
                    Case 0, 1, 2
                        intRedTeams(intSlotCounter \ 8, intSlotCounter Mod 8) = intOriginalFileInfo(intSlotCounter)
                    Case 3
                        intRedScore(intSlotCounter \ 8) = intOriginalFileInfo(intSlotCounter)
                    Case 4, 5, 6
                        intBlueTeams(intSlotCounter \ 8, (intSlotCounter Mod 8) - 4) = intOriginalFileInfo(intSlotCounter)
                    Case 7
                        intBlueScore(intSlotCounter \ 8) = intOriginalFileInfo(intSlotCounter)

                End Select
            Next

            'Populate the Total Teams array
            Dim intUnsortedTeams(((intBlueTeams.GetLength(0)) * 3) - 1) As Integer
            Dim intTeamCounter As Integer = 0
            For intAllBlueTeams As Integer = 0 To intBlueTeams.GetLength(0) - 1
                For intRobotSlot As Integer = 0 To 2
                    intUnsortedTeams(intTeamCounter) = intBlueTeams(intAllBlueTeams, intRobotSlot)
                    intTeamCounter += 1
                Next
            Next
            Array.Sort(intUnsortedTeams)
            Dim intPreviousRobot As Integer = -1
            Dim intCurrentRobot As Integer = 0
            Dim intTotalNumberOfTeams As Integer = 0
            For intCurrentTeam As Integer = 0 To intUnsortedTeams.Length - 1
                intCurrentRobot = intUnsortedTeams(intCurrentTeam)
                If intCurrentRobot <> intPreviousRobot Then
                    ReDim Preserve intTeams(intTotalNumberOfTeams)
                    intTeams(intTotalNumberOfTeams) = intCurrentRobot
                    intPreviousRobot = intCurrentRobot
                    intTotalNumberOfTeams += 1
                End If
            Next

            'Calculate the sum of the score for a given Team
            For intTeam As Integer = 0 To intTeams.Length - 1
                For intBlueAlliance As Integer = 0 To intBlueTeams.GetLength(0) - 1
                    For intBlueSlot As Integer = 0 To 2
                        If intTeams(intTeam) = intBlueTeams(intBlueAlliance, intBlueSlot) Then
                            ReDim Preserve intTeamsScore(intTeam)
                            intTeamsScore(intTeam) += intBlueScore(intBlueAlliance)
                        End If
                    Next
                Next
                For intRedAlliance As Integer = 0 To intRedTeams.GetLength(0) - 1
                    For intRedSlot As Integer = 0 To 2
                        If intTeams(intTeam) = intRedTeams(intRedAlliance, intRedSlot) Then
                            ReDim Preserve intTeamsScore(intTeam)
                            intTeamsScore(intTeam) += intRedScore(intRedAlliance)
                        End If
                    Next
                Next
            Next

            'Calculates the OPR Matrix
            ReDim intOPRArray(intTeams.Length - 1, intTeams.Length - 1)
            Dim intRobotOne As Integer = 0
            Dim intRobotTwo As Integer = 0
            Dim RobotOneInSlot As Boolean = False
            Dim RobotTwoInSlot As Boolean = False
            For intY As Integer = 0 To intOPRArray.GetLength(0) - 1
                For intX As Integer = 0 To intOPRArray.GetLength(1) - 1
                    intRobotOne = intTeams(intY)
                    intRobotTwo = intTeams(intX)

                    'Checks if both robots have played in multiple blue matches with each other
                    For intLookThroughBlue As Integer = 0 To intBlueTeams.GetLength(0) - 1

                        'Checks if the specified Robot is in the Specified Match
                        For intCheckMatch As Integer = 0 To 2
                            If intRobotOne = intBlueTeams(intLookThroughBlue, intCheckMatch) Then
                                RobotOneInSlot = True
                            End If
                        Next

                        'Checks if the second specified Robot is int he Specified Match
                        For intCheckMatch As Integer = 0 To 2
                            If intRobotTwo = intBlueTeams(intLookThroughBlue, intCheckMatch) Then
                                RobotTwoInSlot = True
                            End If
                        Next

                        'Checks if both robots are int he same match
                        If RobotOneInSlot = True And RobotTwoInSlot = True Then
                            intOPRArray(intY, intX) += 1
                        End If

                        'Resets
                        RobotOneInSlot = False
                        RobotTwoInSlot = False
                    Next

                    'Checks if both robots have played in multiple red matches with each other
                    For intLookThroughRed As Integer = 0 To intRedTeams.GetLength(0) - 1

                        'Checks if the specified Robot is in the Specified Match
                        For intCheckMatch As Integer = 0 To 2
                            If intRobotOne = intRedTeams(intLookThroughRed, intCheckMatch) Then
                                RobotOneInSlot = True
                            End If
                        Next

                        'Checks if the second specified Robot is int he Specified Match
                        For intCheckMatch As Integer = 0 To 2
                            If intRobotTwo = intRedTeams(intLookThroughRed, intCheckMatch) Then
                                RobotTwoInSlot = True
                            End If
                        Next

                        'Checks if both robots are int he same match
                        If RobotOneInSlot = True And RobotTwoInSlot = True Then
                            intOPRArray(intY, intX) += 1
                        End If

                        'Resets
                        RobotOneInSlot = False
                        RobotTwoInSlot = False
                    Next

                Next
            Next
        End If
    End Sub

    Sub WriteFile(ByVal intTeams() As Integer, ByVal matrixOPR() As Double)
        Dim outFile As System.IO.FileStream
        outFile = New System.IO.FileStream(My.Application.Info.DirectoryPath & "\OPR.Text", _
           IO.FileMode.Create, IO.FileAccess.Write)
        Dim fileWriter As New System.IO.StreamWriter(outFile)
        For intCounter As Integer = 0 To intTeams.Length - 1
            fileWriter.WriteLine(intTeams(intCounter) & "," & matrixOPR(intCounter))
        Next
        fileWriter.Close()
        outFile.Close()
    End Sub

End Module

Module MatrixHelper

    Public Function Multiply(ByVal matrix1(,) As Double, ByVal vector() As Double) As Double()
        Dim matrix2(UBound(vector)) As Double
        Dim tempOPR As Double
        For rIndex As Integer = 0 To UBound(vector)
            tempOPR = 0
            For cIndex As Integer = 0 To UBound(vector)
                tempOPR += matrix1(rIndex, cIndex) * vector(cIndex)
            Next
            matrix2(rIndex) = tempOPR
        Next
        Return matrix2
    End Function

    Public Function MakeDisplayable(ByVal sourceMatrix(,) As Double) As String
        ' ----- Prepare a multi-line string that shows the contents
        '       of a matrix, a 2D array.
        Dim rows As Integer
        Dim cols As Integer
        Dim eachRow As Integer
        Dim eachCol As Integer
        Dim result As New System.Text.StringBuilder

        ' ----- Process all rows of the matrix, generating one
        '       output line per row.
        rows = UBound(sourceMatrix, 1) + 1
        cols = UBound(sourceMatrix, 2) + 1
        For eachRow = 0 To rows - 1
            ' ----- Process each column of the matrix on a single
            '       row, separating values by commas.
            If (eachRow > 0) Then result.AppendLine()
            For eachCol = 0 To cols - 1
                ' ----- Add a single matrix element to the output.
                If (eachCol > 0) Then result.Append(",")
                result.Append(sourceMatrix(eachRow, eachCol).ToString)
            Next eachCol
        Next eachRow

        ' ----- Finished.
        Return result.ToString
    End Function

    Public Function MakeDisplayable(ByVal sourceArray() As Double) As String
        ' ----- Present an array as multiple lines of output.
        Dim result As New System.Text.StringBuilder
        Dim scanValue As Double

        For Each scanValue In sourceArray
            result.AppendLine(scanValue.ToString)
        Next scanValue

        Return result.ToString
    End Function

    Public Function Inverse(ByVal sourceMatrix(,) As Double) As Double(,)
        ' ----- Build a new matrix that is the mathematical inverse
        '       of the supplied matrix. Multiplying a matrix and its
        '       inverse together will give the identity matrix.
        Dim eachCol As Integer
        Dim eachRow As Integer
        Dim rowsAndCols As Integer

        ' ----- Determine the size of each dimension of the matrix.
        '       Only square matrices can be inverted.
        If (UBound(sourceMatrix, 1) <> UBound(sourceMatrix, 2)) Then
            Throw New Exception("Matrix must be square.")
        End If
        Dim rank As Integer = UBound(sourceMatrix, 1)

        ' ----- Clone a copy of the matrix (not just a new reference).
        Dim workMatrix(,) As Double = _
            CType(sourceMatrix.Clone, Double(,))

        ' ----- Variables used for backsolving.
        Dim destMatrix(rank, rank) As Double
        Dim rightHandSide(rank) As Double
        Dim solutions(rank) As Double
        Dim rowPivots(rank) As Integer
        Dim colPivots(rank) As Integer

        ' ----- Use LU decomposition to form a triangular matrix.
        workMatrix = FormLU(workMatrix, rowPivots, colPivots, rowsAndCols)

        ' ----- Backsolve the triangular matrix to get the inverted
        '       value for each position in the final matrix.
        For eachCol = 0 To rank
            rightHandSide(eachCol) = 1
            BackSolve(workMatrix, rightHandSide, solutions, rowPivots, colPivots)
            For eachRow = 0 To rank
                destMatrix(eachRow, eachCol) = solutions(eachRow)
                rightHandSide(eachRow) = 0
            Next eachRow
        Next eachCol

        ' ----- Return the inverted matrix result.
        Return destMatrix
    End Function

Private Sub BackSolve(ByVal sourceMatrix(,) As Double, _
            ByVal rightHandSide() As Double, ByVal solutions() As Double, _
            ByRef rowPivots() As Integer, ByRef colPivots() As Integer)
        ' ----- Solve an upper-right-triangle matrix.
        Dim pivot As Integer
        Dim rowToPivot As Integer
        Dim colToPivot As Integer
        Dim eachRow As Integer
        Dim eachCol As Integer
        Dim rank As Integer = UBound(sourceMatrix, 1)

        ' ----- Work through all pivot points. This section builds
        '       the "B" in the AX=B formula.
        For pivot = 0 To (rank - 1)
            colToPivot = colPivots(pivot)
            For eachRow = (pivot + 1) To rank
                rowToPivot = rowPivots(eachRow)
                rightHandSide(rowToPivot) += _
                    sourceMatrix(rowToPivot, colToPivot) _
                    * rightHandSide(rowPivots(pivot))
            Next eachRow
        Next pivot

        ' ----- Now solve for each X using the general formula
        '       x(i) = (b(i) - summation(a(i,j)x(j)))/a(i,i)
        For eachRow = rank To 0 Step -1
            colToPivot = colPivots(eachRow)
            rowToPivot = rowPivots(eachRow)
            solutions(colToPivot) = rightHandSide(rowToPivot)
            For eachCol = (eachRow + 1) To rank
                solutions(colToPivot) -= _
                    sourceMatrix(rowToPivot, colPivots(eachCol)) _
                    * solutions(colPivots(eachCol))
            Next eachCol
            solutions(colToPivot) /= sourceMatrix(rowToPivot, colToPivot)
        Next eachRow
    End Sub

    Private Function FormLU(ByVal sourceMatrix(,) As Double, _
            ByRef rowPivots() As Integer, ByRef colPivots() As Integer, _
            ByRef rowsAndCols As Integer) As Double(,)
        ' ----- Perform an LU (lower and upper) decomposition of a matrix,
        '       a modified form of Gaussian elimination.
        Dim eachRow As Integer
        Dim eachCol As Integer
        Dim pivot As Integer
        Dim rowIndex As Integer
        Dim colIndex As Integer
        Dim bestRow As Integer
        Dim bestCol As Integer
        Dim rowToPivot As Integer
        Dim colToPivot As Integer
        Dim maxValue As Double
        Dim testValue As Double
        Dim oldMax As Double
        Const Deps As Double = 0.0000000000000001

        ' ----- Determine the size of the array.
        Dim rank As Integer = UBound(sourceMatrix, 1)
        Dim destMatrix(rank, rank) As Double
        Dim rowNorm(rank) As Double
        ReDim rowPivots(rank)
        ReDim colPivots(rank)

        ' ----- Make a copy of the array so we don't mess it up.
        Array.Copy(sourceMatrix, destMatrix, sourceMatrix.Length)

        ' ----- Initialize row and column pivot arrays.
        For eachRow = 0 To rank
            rowPivots(eachRow) = eachRow
            colPivots(eachRow) = eachRow
            For eachCol = 0 To rank
                rowNorm(eachRow) += Math.Abs(destMatrix(eachRow, eachCol))
            Next eachCol
            If (rowNorm(eachRow) = 0) Then
                Throw New Exception("Cannot invert a singular matrix.")
            End If
        Next eachRow

        ' ----- Use Gauss-Jordan elimination on the matrix rows.
        For pivot = 0 To rank - 1
            maxValue = 0
            For eachRow = pivot To rank
                rowIndex = rowPivots(eachRow)
                For eachCol = pivot To rank
                    colIndex = colPivots(eachCol)
                    testValue = Math.Abs(destMatrix(rowIndex, colIndex)) _
                        / rowNorm(rowIndex)
                    If (testValue > maxValue) Then
                        maxValue = testValue
                        bestRow = eachRow
                        bestCol = eachCol
                    End If
                Next eachCol
            Next eachRow

            ' ----- Detect a singular, or very nearly singular, matrix.
            If (maxValue = 0) Then
                Throw New Exception("Singular matrix used for LU.")
            ElseIf (pivot > 1) Then
                If (maxValue < (Deps * oldMax)) Then
                    Throw New Exception("Non-invertible matrix used for LU.")
                End If
            End If
            oldMax = maxValue

            ' ----- Swap row pivot values for the best row.
            If (rowPivots(pivot) <> rowPivots(bestRow)) Then
                rowsAndCols += 1
                Swap(rowPivots(pivot), rowPivots(bestRow))
            End If

            ' ----- Swap column pivot values for the best column.
            If (colPivots(pivot) <> colPivots(bestCol)) Then
                rowsAndCols += 1
                Swap(colPivots(pivot), colPivots(bestCol))
            End If

            ' ----- Work with the current pivot points.
            rowToPivot = rowPivots(pivot)
            colToPivot = colPivots(pivot)

            ' ----- Modify the remaining rows from the pivot points.
            For eachRow = (pivot + 1) To rank
                rowIndex = rowPivots(eachRow)
                destMatrix(rowIndex, colToPivot) = _
                    -destMatrix(rowIndex, colToPivot) / _
                    destMatrix(rowToPivot, colToPivot)
                For eachCol = (pivot + 1) To rank
                    colIndex = colPivots(eachCol)
                    destMatrix(rowIndex, colIndex) += _
                        destMatrix(rowIndex, colToPivot) * _
                        destMatrix(rowToPivot, colIndex)
                Next eachCol
            Next eachRow
        Next pivot

        ' ----- Detect a non-invertible matrix.
        If (destMatrix(rowPivots(rank), colPivots(rank)) = 0) Then
            Throw New Exception("Non-invertible matrix used for LU.")
        ElseIf (Math.Abs(destMatrix(rowPivots(rank), colPivots(rank))) / _
                rowNorm(rowPivots(rank))) < (Deps * oldMax) Then
            Throw New Exception("Non-invertible matrix used for LU.")
        End If

        ' ----- Success. Return the LU triangular matrix.
        Return destMatrix
    End Function

End Module

Can you just “zip” the project, and post that because I’m lost. I’ve never used Module’s nor Import’s. :confused:
(now that I think about it, I’ve never used loops either but that are self-explanatory.)

Zip file is attached. Just for future reference though, a module is just a way of organizing code and imports are using external packages to add additional methods and classes to your project.

CalculateOPR.zip (121 KB)


CalculateOPR.zip (121 KB)

If you want to calculate OPR, especially on large sets of data, I STRONGLY suggest not trying to invert the matrix. It’s an extremely computationally intensive operation. However, SOLVING, the matrix is much less so. You can do so by getting your matrix into reduced row echelon form. Here’s the MATLAB code for it, I’m not entirely sure how one would do it in VB, but presumably, you would use the same algorithm:

function [A,jb] = rref(A,tol)
%RREF   Reduced row echelon form.
%   R = RREF(A) produces the reduced row echelon form of A.
%
%   [R,jb] = RREF(A) also returns a vector, jb, so that:
%       r = length(jb) is this algorithm's idea of the rank of A,
%       x(jb) are the bound variables in a linear system, Ax = b,
%       A(:,jb) is a basis for the range of A,
%       R(1:r,jb) is the r-by-r identity matrix.
%
%   [R,jb] = RREF(A,TOL) uses the given tolerance in the rank tests.
%
%   Roundoff errors may cause this algorithm to compute a different
%   value for the rank than RANK, ORTH and NULL.
%
%   Class support for input A:
%      float: double, single
%
%   See also RANK, ORTH, NULL, QR, SVD.

%   Copyright 1984-2005 The MathWorks, Inc. 
%   $Revision: 5.9.4.3 $  $Date: 2006/01/18 21:58:54 $

[m,n] = size(A);

% Does it appear that elements of A are ratios of small integers?
[num, den] = rat(A);
rats = isequal(A,num./den);

% Compute the default tolerance if none was provided.
if (nargin < 2), tol = max(m,n)*eps(class(A))*norm(A,'inf'); end

% Loop over the entire matrix.
i = 1;
j = 1;
jb = ];
while (i <= m) && (j <= n)
   % Find value and index of largest element in the remainder of column j.
   [p,k] = max(abs(A(i:m,j))); k = k+i-1;
   if (p <= tol)
      % The column is negligible, zero it out.
      A(i:m,j) = zeros(m-i+1,1);
      j = j + 1;
   else
      % Remember column index
      jb = [jb j];
      % Swap i-th and k-th rows.
      A(*,j:n) = A([k i],j:n);
      % Divide the pivot row by the pivot element.
      A(i,j:n) = A(i,j:n)/A(i,j);
      % Subtract multiples of the pivot row from all the other rows.
      for k = [1:i-1 i+1:m]
         A(k,j:n) = A(k,j:n) - A(k,j)*A(i,j:n);
      end
      i = i + 1;
      j = j + 1;
   end
end

% Return "rational" numbers if appropriate.
if rats
    [num,den] = rat(A);
    A=num./den;
end

Thank you. This is extremely helpful.

For this problem, forming and solving the normal equations with Cholesky factorization is stable and is the fastest method.

The matrix of the normal equations can easily be formed directly, in a single pass through the match data, and the resulting matrix needs no further processing in order to be factored.

Using this method, an end-of-year 2053x2053 system is easily solved in 12 seconds on a 3.4GHz Pentium D with 1GB RAM 32bit WinXP Pro SP3.

More detail is available here.