I wanted to generate 9 random numbers. Then I would get 4 random numbers from that 9, but the four random entries* can't repeat.
There are 28 possible outcomes. The randomizing works fine but I don't understand why I can't get the checkboxes to get checked. I've been trying all day please help
Dim rn As New Random
Dim n(9) As Integer
n(1) = rn.Next(1, 2)
n(2) = rn.Next(1, 3)
n(3) = 1
n(4) = rn.Next(1, 3)
n(5) = 1
n(6) = rn.Next(1, 4)
n(7) = rn.Next(1, 7)
n(8) = rn.Next(1, 4)
n(9) = rn.Next(1, 3)
Dim loopcount As Integer = 4
Dim l(4), ln, lm As Integer
ln = 1
lm = 1
l(1) = rn.Next(1, 9)
l(2) = rn.Next(1, 9)
While l(2) = l(1)
l(2) = rn.Next(1, 9)
End While
l(3) = rn.Next(1, 9)
While l(3) = l(2) Or l(3) = l(1)
l(3) = rn.Next(1, 9)
End While
l(4) = rn.Next(1, 9)
While l(4) = l(3) Or l(4) = l(2) Or l(4) = l(1)
l(3) = rn.Next(1, 9)
End While
MsgBox(l(1) & l(2) & l(3) & l(4))
MsgBox(n(1) & n(2) & n(3) & n(4) & n(5) & n(6) & n(7) & n(8) & n(9))
While loopcount > 0
If ln = 1 Then lm = l(1)
If ln = 2 Then lm = l(2)
If ln = 3 Then lm = l(3)
If ln = 4 Then lm = l(4)
If l(ln) = 1 & n(lm) = 1 Then 1.CheckState = 1
If l(ln) = 1 & n(lm) = 2 Then 2.CheckState = 1
If l(ln) = 2 & n(lm) = 1 Then 3.CheckState = 1
If l(ln) = 2 & n(lm) = 2 Then 4.CheckState = 1
If l(ln) = 2 & n(lm) = 3 Then 5.CheckState = 1
If l(ln) = 3 & n(lm) = 1 Then 6.CheckState = 1
If l(ln) = 4 & n(lm) = 1 Then 7.CheckState = 1
If l(ln) = 4 & n(lm) = 2 Then 8.CheckState = 1
If l(ln) = 4 & n(lm) = 3 Then 9.CheckState = 1
If l(ln) = 5 & n(lm) = 1 Then 10.CheckState = 1
If l(ln) = 6 & n(lm) = 1 Then 11.CheckState = 1
If l(ln) = 6 & n(lm) = 2 Then 12.CheckState = 1
If l(ln) = 6 & n(lm) = 3 Then 13.CheckState = 1
If l(ln) = 6 & n(lm) = 4 Then 14.CheckState = 1
If l(ln) = 7 & n(lm) = 1 Then 15.CheckState = 1
If l(ln) = 7 & n(lm) = 2 Then 16.CheckState = 1
If l(ln) = 7 & n(lm) = 3 Then 17.CheckState = 1
If l(ln) = 7 & n(lm) = 4 Then 18.CheckState = 1
If l(ln) = 7 & n(lm) = 5 Then 19.CheckState = 1
If l(ln) = 7 & n(lm) = 6 Then 20.CheckState = 1
If l(ln) = 7 & n(lm) = 7 Then 21.CheckState = 1
If l(ln) = 8 & n(lm) = 1 Then 22.CheckState = 1
If l(ln) = 8 & n(lm) = 2 Then 23.CheckState = 1
If l(ln) = 8 & n(lm) = 3 Then 24.CheckState = 1
If l(ln) = 8 & n(lm) = 4 Then 25.CheckState = 1
If l(ln) = 9 & n(lm) = 1 Then 26.CheckState = 1
If l(ln) = 9 & n(lm) = 2 Then 27.CheckState = 1
If l(ln) = 9 & n(lm) = 3 Then 28.CheckState = 1
ln = ln + 1
loopcount = loopcount - 1
End While
Call Generate()
I think you need to either rename your check boxes or use square brackets:
[1].CheckState = 1 'for example.
Also, you've used & which should be And...
If l(ln) = 1 & n(lm) = 1 Then 1.CheckState = 1
...should be...
If l(ln) = 1 And n(lm) = 1 Then [1].CheckState = 1
Though this could be shortened to...
[1].CheckState = 1 And (l(ln) = 1) And (n(lm) = 1)
Related
I'm trying to shift the bits from old: to new:, If 2 same values are encountered a second time, then it should skip them I guess, that's why first example is broken.
Here is my code:
txtUndoPlaintext.Text = Replace(txtUndoPlaintext.Text, " ", " ")
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimStart(CChar(" "))
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimEnd(CChar(" "))
Dim UniqueList() As Byte = Split(txtUndoPlaintext.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtPlainText.Text = Replace(txtPlainText.Text, " ", " ")
txtPlainText.Text = txtPlainText.Text.TrimStart(CChar(" "))
txtPlainText.Text = txtPlainText.Text.TrimEnd(CChar(" "))
Dim OriginalUniqueList() As Byte = Split(txtPlainText.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtUndoBitMask.Text = Replace(txtUndoBitMask.Text, " ", " ")
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimStart(CChar(" "))
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimEnd(CChar(" "))
bitmask = Split(txtUndoBitMask.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
For i = 0 To UniqueList.Length - 1
For j = (i + 1) To OriginalUniqueList.Length - 1
If OriginalUniqueList(i) = UniqueList(j) Then
Exit For
End If
Next j
'If OriginalUniqueList(i) = UniqueList(i) Then
' bitmaskCounter += 1
' Continue For
' End If
'If OriginalUniqueList(j) = UniqueList(j) Then
'bitmaskCounter += 1
'Continue For
'End If
If (j < OriginalUniqueList.Length - 1) AndAlso newbitmask(i) = 1 AndAlso newbitmask(j) = 1 AndAlso bitmask(bitmaskCounter) = 1 Then
newbitmask(i) = 1
newbitmask(j) = 1
ElseIf (j > OriginalUniqueList.Length - 1) AndAlso bitmask(bitmaskCounter) = 1 Then
newbitmask(i) = 1
ElseIf (j < OriginalUniqueList.Length - 1) AndAlso OriginalUniqueList(i) = UniqueList(i) Then
newbitmask(i) = 0
ElseIf bitmask(bitmaskCounter) = 1 Then
newbitmask(j) = 1
End If
bitmaskCounter += 1
Next
Broken Example.
value before: 1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2
value after: 1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2
old: 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0
new: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0
2,4 = good
3,8 = bad [this is broken]
7,11 = good
Here are good examples that work properly.
Good Example.
value before: 1 2 3 1 2 3 4 1 2 3 4
value after: 1 2 3 4 1 2 3 4 1 2 3
old: 0 0 0 1 0 0 1 0 0 0 0
new: 0 0 0 0 1 0 0 1 0 0 0
3,4 = good
6,7 = good
Good Example.
value before: 1 2 1 3 2 3 2 4
value after: 1 2 4 1 2 3 2 3
old: 0 0 1 1 0 1 0 0
new: 0 0 0 1 0 1 0 1
2,3 = good
3,5 = good
5,7 = good
Good Example.
value before: 1 2 1 3 2
value after: 1 2 1 2 3
old: 0 0 1 1 0
new: 0 0 1 0 1
2,2 = good
3,4 = good
New Code update
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
Dim bitmaskCounter As Integer = 0
Dim UniqueList() As Byte = Split("1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim OriginalUniqueList() As Byte = Split("1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim TheValues = New List(Of Byte)(UniqueList)
bitmask = Split("0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
Dim i As Integer = 0
Dim j As Integer = 0
Dim ignoreOldOffsets As New List(Of Short)
Dim ignoreNewOffsets As New List(Of Short)
Dim found As Boolean = False
While i >= 0
found = False
Do While j > 0
If j = OriginalUniqueList.Length Then Exit Do
If OriginalUniqueList(j) = UniqueList(i) Then
found = True
Exit Do
End If
j += 1
Loop
If bitmaskCounter >= bitmask.Length Then Exit While
If j = i AndAlso OriginalUniqueList(j) = UniqueList(i) OrElse j = OriginalUniqueList.Length Then
bitmaskCounter += 1
ignoreOldOffsets.Add(i)
ignoreNewOffsets.Add(j)
j = i + 1
i += 1
Continue While
End If
If ignoreOldOffsets.Contains(i) AndAlso ignoreNewOffsets.Contains(j) Then
bitmaskCounter += 1
j = i
Continue While
End If
'If OriginalUniqueList(j) = UniqueList(j) Then
'bitmaskCounter += 1
'Continue For
'End If
'newbitmask(i) = 1
'newbitmask(j) = 1
'ignoreOffsets.Add(i)
'ignoreOffsets.Add(j)
If bitmask(i) = 1 Then
newbitmask(i) = 1
newbitmask(j) = 1
ignoreOldOffsets.Add(i)
ignoreNewOffsets.Add(j)
End If
bitmaskCounter += 1
i += 1
j = i
End While
'Fixed bits output to textbox.
txtOutput.Text += "New Bits: "
For i = 0 To newbitmask.Length - 1
txtOutput.Text += newbitmask(i) & " "
Next
txtOutput.Text += vbCrLf
'Reset bitmaskCounter.
bitmaskCounter = 0
End Sub
In the code above
old: 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0
new: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0
i get: 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0
Solved!!!
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
Dim bitmaskCounter As Integer = 0
'Dim UniqueList() As Byte = Split("1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim UniqueList() As Byte = Split("1 2 3 1 2 3 4 1 2 3 4", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 3 4 1 2 3 4 1 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 0 1 0 0 1 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim UniqueList() As Byte = Split("1 2 1 3 2 3 2 4", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 4 1 2 3 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 1 1 0 1 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim UniqueList() As Byte = Split("1 2 1 3 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim OriginalUniqueList() As Byte = Split("1 2 1 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim TheValues = New List(Of Byte)(UniqueList)
bitmask = Split("0 0 1 1 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
Dim i As Integer = 0
Dim j As Integer = 0
Dim found As Boolean = False
Dim firstDuplicateIndex As Integer = -1
Dim uniquesFound As New List(Of Byte)
For k = 0 To UniqueList.Length - 1
If uniquesFound.Contains(OriginalUniqueList(k)) = False Then
uniquesFound.Add(OriginalUniqueList(k))
Else
firstDuplicateIndex = k
Exit For
End If
Next
Dim offsetsComplete As New List(Of Integer)
While i >= 0
i = Array.IndexOf(bitmask, CByte(1), i + 1)
j = i '(i + 1)
If i = -1 OrElse UniqueList.Length = i Then Exit While
found = False
Do While j >= 0
If j = OriginalUniqueList.Length Then Exit Do
If j < firstDuplicateIndex OrElse OriginalUniqueList(j) = UniqueList(j) AndAlso bitmask(j) <> 1 OrElse offsetsComplete.Contains(j) Then
j += 1
Continue Do
End If
If OriginalUniqueList(j) = UniqueList(i) Then
found = True
Exit Do
End If
j += 1
Loop
If bitmaskCounter >= bitmask.Length Then Exit While
If j < bitmask.Length AndAlso bitmask(i) = 1 Then
newbitmask(j) = 1
offsetsComplete.Add(j)
End If
bitmaskCounter += 1
End While
'Fixed bits output to textbox.
txtOutput.Text += "New Bits A: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0" & vbNewLine
txtOutput.Text += "New Bits B: "
For i = 0 To newbitmask.Length - 1
txtOutput.Text += newbitmask(i) & " "
Next
txtOutput.Text += vbCrLf
'Reset bitmaskCounter.
bitmaskCounter = 0
End Sub
I want to create a bidimensional array to plot checkboxes in rows and cols. Nevertheless, this line is not working:
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
The checkboxes are not shown in the location defined.
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
Dim CheckB_Well(,)
Dim rows_C1 As Integer
Dim cols_C1 As Integer
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
ReDim CheckB_Well(well_rows - 1, well_cols - 1)
For rows_C1 = 0 To well_rows - 1
For cols_C1 = 0 To well_cols - 1
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Text = Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Visible = True
If rows_C1 Mod 2 = 0 Then
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
Else
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), 20 + 25 * (well_rows - 1 - rows_C1))
End If
Me.GroupBox3.Controls.Add(CheckB_Well(rows_C1, cols_C1))
Next cols_C1
Next rows_C1
End Sub
You just need to set AutoSize to True:
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).AutoSize = True
Because it was drawing from left to right on even rows, the extra space from the default size was covering up the CheckBoxes to the right.
Side Note: What is the point of creating the 2D array Dim CheckB_Well(,)? It's a local variable, so it's not necessary:
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
For rows_C1 As Integer = 0 To well_rows - 1
Dim Y As Integer = 20 + 25 * (well_rows - 1 - rows_C1)
For cols_C1 As Integer = 0 To well_cols - 1
Dim CB As New CheckBox
CB.AutoSize = True
CB.Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CB.Text = Str(rows_C1) + ";" + Str(cols_C1)
If rows_C1 Mod 2 = 0 Then
CB.Location = New Point(40 + 50 * cols_C1, Y)
Else
CB.Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), Y)
End If
Me.GroupBox3.Controls.Add(CB)
Next cols_C1
Next rows_C1
End Sub
Output:
For example I have 2d array
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
So
testArray = Application.Transpose(tKey)
assign like 1D array
testArray(1) = 1
testArray(2) = 2
testArray(3) = 3
Instead of expected
testArray(1,1) = 1
testArray(1,2) = 2
testArray(1,3) = 3
But if tKey
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
tKey(0, 1) = 1
tKey(1, 1) = 2
tKey(2, 1) = 3
then
testArray = Application.Transpose(tKey)
assign like 2D array, like expected
testArray(1,1) = 1
testArray(1,2) = 2
testArray(1,3) = 3
testArray(2,1) = 1
testArray(2,2) = 2
testArray(2,3) = 3
test code
Sub testss()
Dim tKey(0 To 2, 0 To 0) As Variant
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
testArray1 = Application.Transpose(tKey) ' wrong assignment
Dim tKey2(0 To 2, 0 To 1) As Variant
tKey2(0, 0) = 1
tKey2(1, 0) = 2
tKey2(2, 0) = 3
tKey2(0, 1) = 1
tKey2(1, 1) = 2
tKey2(2, 1) = 3
testArray2 = Application.Transpose(tKey2) ' good assignment
Stop
End Sub
Is that a bug? How to assign correct one value to 2d array using Application.Transpose?
I am making a program for a game. It takes the level of the class (of which you can have 8 simultaneous different ones of different level). Each class has different values for one Dim I have known as Defense, it has 6 different possibly levels. Each of those 6 levels corresponds with a value based on the level of each class.
I'm almost certain I need an array or a list, I've seen some examples here but I haven't seen something that quite fits my case.
Do I need to have an array within an array? Is that even possible?
I apologize if I'm horrible at explaining what I'm trying to accomplish.
An example would be if the person chose Strong Hero and then chose Level 4. Following that they'd pick Fast Hero and chose Level 5. I'm trying to get it to look at what the value for 4 would be for Strong Hero and the value for Fast Hero, find those and then add them into Def at the end.
Thank you in advance for anyone who is willing to put up with my ignorance!
Dim Def As Integer = 0
'Declares a single-dimension array of 10 values
Dim DefLvl(9) As Integer
Dim DefType As String = ""
Dim DefLvl1 As Integer = 0
Dim DefLvl2 As Integer = 0
Dim DefLvl3 As Integer = 0
Dim DefLvl4 As Integer = 0
Dim DefLvl5 As Integer = 0
Dim DefLvl6 As Integer = 0
Dim DefLvl7 As Integer = 0
Dim DefLvl8 As Integer = 0
Dim DefLvl9 As Integer = 0
Dim DefLvl10 As Integer = 0
'This sets the cmblevel.text = to an integer to be multiplied later
'Level 1
If cmbLevel1.Text = "1" Then
Level1 = 1
ElseIf cmbLevel1.Text = "2" Then
Level1 = 2
ElseIf cmbLevel1.Text = "3" Then
Level1 = 3
ElseIf cmbLevel1.Text = "4" Then
Level1 = 4
ElseIf cmbLevel1.Text = "5" Then
Level1 = 5
ElseIf cmbLevel1.Text = "6" Then
Level1 = 6
ElseIf cmbLevel1.Text = "7" Then
Level1 = 7
ElseIf cmbLevel1.Text = "8" Then
Level1 = 8
ElseIf cmbLevel1.Text = "9" Then
Level1 = 9
ElseIf cmbLevel1.Text = "10" Then
Level1 = 10
End If
'
If cmbClass1.Text = "Strong Hero" Then
HD1 = "8"
DefType = "Avg+"
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
End If
'This formula will calculate Defense for each class and level
If DefType = "Poor" Then
DefLvl1 = 0
DefLvl2 = 1
DefLvl3 = 1
DefLvl4 = 1
DefLvl5 = 2
DefLvl6 = 2
DefLvl7 = 2
DefLvl8 = 3
DefLvl9 = 3
DefLvl10 = 3
ElseIf DefType = "Avg" Then
DefLvl1 = 1
DefLvl2 = 1
DefLvl3 = 2
DefLvl4 = 2
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Avg+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Good" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 6
DefLvl10 = 7
ElseIf DefType = "Good+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 7
DefLvl10 = 7
ElseIf DefType = "Great" Then
DefLvl1 = 3
DefLvl2 = 4
DefLvl3 = 4
DefLvl4 = 5
DefLvl5 = 5
DefLvl6 = 6
DefLvl7 = 6
DefLvl8 = 7
DefLvl9 = 7
DefLvl10 = 8
End If
'This adds up to all 8 classes' DefLvls
Def = DefLvl1 + DefLvl2 + DefLvl3 + DefLvl4 + DefLvl5 + DefLvl6 + DefLvl7 + DefLvl8 + dexM
The data set is in the following format: Input sample matrix X and output class vector Y such that each row in X is a sample and each of its column corresponds to a feature. Each index in Y corresponds to the respective output class for the corresponding sample in X. X can contain real numbers while Y contains positive integers.
My aim is to order the data set in terms of its class. For example
X = Y =
1 8 3 2
4 2 6 1
7 8 9 2
2 3 4 3
1 4 6 1
should be ordered and interleaved as
X = Y =
4 2 6 1
1 8 3 2
2 3 4 3
1 4 6 1
7 8 9 2
The code I've attempted seems to take a long time to run as it is based on serial execution. It is the following.
X = csvread('X.csv');
Y = csvread('Y.csv');
n = size(unique(Y),1);
m = size(X,1);
for i = 1:n
Dataset(i).X = X(Y==i,:);
Dataset(i).Y = Y(Y==i);
end
[num, ~] = hist(Y,n);
maxfreq = max(num);
NewX = [];
NewY = [];
for j = 1:maxfreq
for i = 1:n
if(j <= size(Dataset(i).X,1))
NewX = [NewX; Dataset(i).X(j,:)];
NewY = [NewY; i];
end
end
end
X = NewX;
Y = NewY;
clear NewX;
clear NewY;
csvwrite('OrderedX.csv', X);
csvwrite('OrderedY.csv', Y);
Is is possible to parallelize the above code?
You're resizing matrices all the time which is expensive. A quick speedup for your algorithm would be to set NewX and NewY to the proper size and just copy data in:
NewX = zeros(size(X));
NewY = zeros(size(Y));
k = 1;
for j = 1:maxfreq
for i = 1:n
if(j <= size(Dataset(i).X,1))
NewX(k,:) = Dataset(i).X(j,:);
NewY(k) = i;
k=k+1;
end
end
end
Approach #1 Using cumsum and diff following the same philosophy as the one listed in this solution -
function [outX,outY] = interleave_cumsum_diff(X,Y)
Y = Y(:);
[R,C] = find(bsxfun(#eq,Y,unique(Y).'));
lens = accumarray(C,1);
out = ones(1,numel(R));
shifts = cumsum(lens(1:end-1));
out(shifts+1) = 1- diff([0 ; shifts]);
[~,idx] = sort(cumsum(out));
sort_idx = R(idx)';
outX = X(sort_idx,:);
outY = Y(sort_idx,:);
Approach #1 Using bsxfun -
function [outX,outY] = interleave_bsxfuns(X,Y)
Y = Y(:);
[R,C] = find(bsxfun(#eq,Y,unique(Y).'));
lens = accumarray(C,1);
mask = bsxfun(#le,[1:max(lens)]',lens.');
V = zeros(size(mask));
V(mask) = R;
Vt = V.';
sort_idx = Vt(mask.');
outX = X(sort_idx,:);
outY = Y(sort_idx,:);
Sample run -
1) Inputs :
>> X
X =
1 8 3
4 2 6
7 8 9
2 3 4
1 4 6
>> Y
Y =
2
1
2
3
1
2) Outputs from the two approaches :
>> [NewX,NewY] = interleave_cumsum_diff(X,Y)
NewX =
4 2 6
1 8 3
2 3 4
1 4 6
7 8 9
NewY =
1
2
3
1
2
>> [NewX,NewY] = interleave_bsxfuns(X,Y)
NewX =
4 2 6
1 8 3
2 3 4
1 4 6
7 8 9
NewY =
1
2
3
1
2