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.
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. 
(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.
