Random Triangular Matrix

Kyudos

I need a test input file for a function I'm developing - no problem I thought, I'll quickly whip one up in Excel and get on with it. I've now been trying to create the test file for three days! It seems so simple, but probability appears to be working against me! I need a 1000x1000 symmetric matrix with 49 'random' ones in each column, filled in reciprocally to make the thing symmetrical. Obviously as you come to the bottom corner of the matrix the available 'random' slots start to run out. Nevermind I thought, I'll wait until my code gets to the hard bit, stop it and then fill in the missing bits by hand. Unfortunately, I always seem to be left with an insoluble problem - I can't fill in the column, because (somehow) the reciprocal spaces I 'need' have already been used. I'm sure I've made some elementary mistake, but I just can't spot it. Can anyone fix my code? (Or come up with an algorithm that works!) Ugly hacky VBA below:

Option Explicit

Public Sub CreateRandomPeers()

Dim TotalEntries As Integer
Dim colEnd As Integer
Dim rowEnd As Integer
Dim colStart As Integer
Dim rowStart As Integer
Dim curCol As Integer
Dim curRow As Integer
Dim curEntries As Integer
Dim rndEntries As Integer
Dim rndRow As Integer
Dim count As Integer
Dim colcnt As Integer
Dim i As Integer, j As Integer
Dim row As Integer
Dim col As Integer
Dim calcmode As XlCalculation

TotalEntries = 49
colEnd = 1001
rowEnd = 1001
colStart = 2
rowStart = 2

calcmode = Application.Calculation
Application.Calculation = xlCalculationAutomatic 'xlCalculationManual

curRow = rowStart

' For each column, randomly add the appropriate number of entries
For curCol = colStart To colEnd Step 1
    ' First, check if any entries have been added reciprocally from other columns
    curPeers = 0
    For i = rowStart To rowEnd Step 1
        If (Application.Cells(i, curCol) = 1) Then
            curEntries = curEntries + 1
        End If
    Next i
    
    ' Randomly assign remaining entries to the current column
    rndEntries = TotalEntries - curEntries
    Randomize
    count = 0
    While (count < rndEntries)
        DoEvents
        rndRow = CInt(Int((rowEnd - rowStart + 1) \* Rnd())) + rowStart
        ' Check row and column aren't equal
        If (rndRow <> curCol) Then
            ' Check

BillWoodruff

The matrix you are creating would have zeroes on the diagonal, and then you insert "1's" at random on #49 pairs of "symmetric" cells of the form cell[i,j] = 1, and cell[j,i] = 1 ? One thing that "jumped out" at me reading your code:

' Randomly assign remaining entries to the current column
rndEntries = TotalEntries - curEntries

I can't see 'TotalEntries being initialized to any value in your code; is it possible that 'TotalEntries should be: 'TotalPeers ? thanks, Bill

Google CEO, Erich Schmidt: "I keep asking for a product called Serendipity. This product would have access to everything ever written or recorded, know everything the user ever worked on and saved to his or her personal hard drive, and know a whole lot about the user's tastes, friends and predilections." 2004, USA Today interview

Kyudos

Yeah, TotalEntries should be 49, edited to fix :)