I'm currently trying to do some work on a neural network class in visual basic. My main drag at the moment is the multiplication of the matrices is so slow! Here's the code I use right now;
Public Function MultiplyMatricesParallel(ByVal matA As Double()(), ByVal matB As Double()()) As Double()()
Dim matACols As Integer = matA(0).GetLength(0)
Dim matBCols As Integer = matB(0).GetLength(0)
Dim matARows As Integer = matA.GetLength(0)
Dim result(matARows - 1)() As Double
For i = 0 To matARows - 1
ReDim result(i)(matBCols - 1)
Next
Dim tempMat()() As Double = MatrixTranspose(matB)
Parallel.For(0, matARows, Sub(i)
For j As Integer = 0 To matBCols - 1
Dim temp As Double = 0
Dim maA() As Double = matA(i)
Dim maB() As Double = tempMat(j)
For k As Integer = 0 To matACols - 1
temp += maA(k) * maB(k)
Next
result(i)(j) += temp
Next
End Sub)
Return result
End Function
I just jagged arrays as they are quicker in vb than rectangular arrays. Of course they really are rectangular otherwise the matrix multiplication wouldn't work (or make sense). Any advice/help would be appreciated, for reference the matrix size can change but it's currently around 7,000 x 2,000 at the maximum.
Related
I've implemented the quickshift Quick Shift image segmentation algorithm in vb.net.
Now I'm looking for a C++ or vb.net source code which converts the results of the Quick Shift back into an image.
I tried the following code but the result is not satisfactory.
In the meantime I've implemented it in vb.net myself
but the result is not satisfactory.
Dim qs_obj As VlQS
Dim img_dbl() As Double
Dim result_image As Bitmap
img_dbl = ConvertRGB2LabDouble(Source_Image_PCA)
qs_obj = vl_quickshift_new(img_dbl, Source_Image_PCA.Height, Source_Image_PCA.Width, 3)
vl_quickshift_process(qs_obj)
vl_quickshift_set_kernel_size(qs_obj, 10)
vl_quickshift_set_max_dist(qs_obj, 10)
result_image = CType(Source_Image_PCA.Clone, Bitmap)
For y As Integer = 0 To Source_Image_PCA.Height - 1
For x As Integer = 0 To Source_Image_PCA.Width - 1
Dim pixelindex As Integer = qs_obj.parents(y * Source_Image_PCA.Width + x)
Dim col As Integer = pixelindex Mod (Source_Image_PCA.Width)
Dim row As Integer = pixelindex \ Source_Image_PCA.Width
Dim pixel_val As Color
pixel_val = Source_Image_PCA.GetPixel(col, row)
result_image.SetPixel(x, y, pixel_val)
Next
Next
picImageSpecialFnc.Image = result_image
I'm using Logo right now and i'm making a project and basically i want to turn your recorded voice into something visual, only problem is when i go to find code it re that works it requires 1: A picture box and 2: to manually grab the sound .wav file and place it. I already made code to record my voice and to make it into a .Wav file and i already have code to visualize it, just when i run it it appears as a thick square of lines rather than the example i shown. Note: I'm not drawing into a picturebox, i'm drawing directly into the Form by using g.drawline(bleh,bleh,bleh,bleh).
(Example: http://static1.1.sqspcdn.com/static/f/335152/16812948/1330286658510/76_dsc3616.jpeg?token=R1zPNnr9PAoB3WvnDxfFFFvzkMw%3D )
The code im trying to run:
Public Sub DrawSound(x As Integer, y As Integer)
Dim samplez As New List(Of Short)
Dim maxamount As Short
Dim pic As New Bitmap(x, y)
Dim ratio As Integer = (samplez.Count - 1) / (y - 1) 'If there are 10000 samples and 200 pixels, this would be every 50th sample is shown
Dim halfpic As Integer = (x / 2) 'Simply half the height of the picturebox
GC.Collect()
Dim wavefile() As Byte = IO.File.ReadAllBytes("C:\Users\" & Environ$("Username") & "\Documents\Sounds\Mic.wav")
GC.Collect()
Dim memstream As New IO.MemoryStream(wavefile)
Dim binreader As New IO.BinaryReader(memstream)
Dim ChunkID As Integer = binreader.ReadInt32()
Dim filesize As Integer = binreader.ReadInt32()
Dim rifftype As Integer = binreader.ReadInt32()
Dim fmtID As Integer = binreader.ReadInt32()
Dim fmtsize As Integer = binreader.ReadInt32()
Dim fmtcode As Integer = binreader.ReadInt16()
Dim channels As Integer = binreader.ReadInt16()
Dim samplerate As Integer = binreader.ReadInt32()
Dim fmtAvgBPS As Integer = binreader.ReadInt32()
Dim fmtblockalign As Integer = binreader.ReadInt16()
Dim bitdepth As Integer = binreader.ReadInt16()
If fmtsize = 18 Then
Dim fmtextrasize As Integer = binreader.ReadInt16()
binreader.ReadBytes(fmtextrasize)
End If
Dim DataID As Integer = binreader.ReadInt32()
Dim DataSize As Integer = binreader.ReadInt32()
samplez.Clear()
For i = 0 To (DataSize - 3) / 2
samplez.Add(binreader.ReadInt16())
If samplez(samplez.Count - 1) > maxamount Then 'Using this for the pic
maxamount = samplez(samplez.Count - 1)
End If
Next
For i = 1 To x - 10 Step 2 'Steping 2 because in one go, we do 2 samples
Dim leftdata As Integer = Math.Abs(samplez(i * ratio)) 'Grabbing that N-th sample to display. Using Absolute to show them one direction
Dim leftpercent As Single = leftdata / (maxamount * 2) 'This breaks it down to something like 0.0 to 1.0. Multiplying by 2 to make it half.
Dim leftpicheight As Integer = leftpercent * x 'So when the percent is tied to the height, its only a percent of the height
g.DrawLine(Pens.LimeGreen, i, halfpic, i, leftpicheight + halfpic) 'Draw dat! The half pic puts it in the center
Dim rightdata As Integer = Math.Abs(samplez((i + 1) * ratio)) 'Same thing except we're grabbing i + 1 because we'd skip it because of the 'step 2' on the for statement
Dim rightpercent As Single = -rightdata / (maxamount * 2) 'put a negative infront of data so it goes down.
Dim rightpicheight As Integer = rightpercent * x
g.DrawLine(Pens.Blue, i, halfpic, i, rightpicheight + halfpic)
Next
End Sub
X and Y is the middle of the form. And i also would link where i got the code but i forgot where and also, i modified it in attempt to run it directly into he form rather than a picturebox. It worked sorta haha (And there is so many unused dims but all i know is, once i remove one none of the code works haha) So could anyone help?
I am currently trying to code a way to read a text file filled with LOTS of data and create a dynamic 2d array to hold each numeric value in its own cell. The text file has data formatted like this
150.00 0.00030739 0.00030023 21.498 0.00024092
150.01 0.00030778 0.00030061 21.497 0.00024122
150.02 0.00030818 0.00030100 21.497 0.00024151
150.03 0.00030857 0.00030138 21.496 0.00024181
150.04 0.00030896 0.00030177 21.496 0.00024210
150.05 0.00030935 0.00030216 21.496 0.00024239
where the spaces are denoted by a vbTab. This is what I have so far.
Dim strfilename As String
Dim num_rows As Long
Dim num_cols As Long
Dim x As Integer
Dim y As Integer
strfilename = "Location of folder holding file" & ListBox1.SelectedItem
If File.Exists(strfilename) Then
Dim sReader As StreamReader = File.OpenText(strfilename)
Dim strLines() As String
Dim strLine() As String
'Load content of file to strLines array
strLines = sReader.ReadToEnd().Split(Environment.NewLine)
'redimension the array
num_rows = UBound(strLines)
strLine = strLines(0).Split(vbTab)
num_cols = UBound(strLine)
ReDim sMatrix(num_rows, num_cols)
'Copy Data into the array
For x = 0 To num_rows
strLine = strLines(x).Split(vbTab)
For y = 0 To num_cols
sMatrix(x, y) = strLine(y).Trim()
Next
Next
End If
When I run this code I get only the first number in the first column of the array and everything else is missing. I need something that shows all of the values. Any help or guidance would be greatly appreciated
Edit:
Here's a picture of what I'm seeing.
What I'm Seeing
You don't need to read all the data in one lump - you can read it line-by-line and process each line.
I assume that the data is machine-generated so that you know there are no errors. I did however put in a check for the required quantity of items on a line.
I copied the data you gave as an example and edited it to change the spaces to tabs.
Option Strict On
Option Infer On
Imports System.IO
Module Module1
Class Datum
Property Time As Double
Property X As Double
Property Y As Double
Property Z As Double
Property A As Double
Sub New(t As Double, x As Double, y As Double, z As Double, a As Double)
Me.Time = t
Me.X = x
Me.Y = y
Me.Z = z
Me.A = z
End Sub
Sub New()
' empty constructor
End Sub
Overrides Function ToString() As String
Return String.Format("(T={0}, X={1}, Y={2}, Z={3}, A={4}", Time, X, Y, Z, A)
' if using VS2015, you can use the following line instead:
' Return $"T={Time}, X={X}, Y={Y}, Z={Z}, A={A}"
End Function
End Class
Function LoadData(srcFile As String) As List(Of Datum)
Dim data = New List(Of Datum)
Using sr As New StreamReader(srcFile)
While Not sr.EndOfStream()
Dim thisLine = sr.ReadLine()
Dim parts = thisLine.Split({vbTab}, StringSplitOptions.RemoveEmptyEntries)
If parts.Count = 5 Then
data.Add(New Datum(CDbl(parts(0)), CDbl(parts(1)), CDbl(parts(2)), CDbl(parts(3)), CDbl(parts(4))))
End If
End While
End Using
Return data
End Function
Sub Main()
Dim src = "C:\temp\testdata2.txt"
Dim myData = LoadData(src)
For Each datum In myData
Console.WriteLine(datum.ToString())
Next
Console.ReadLine()
End Sub
End Module
As you can see, if you use a class to hold the data then you can usefully give it other methods like .ToString().
Option Strict On makes sure that you do not do anything which is meaningless, like trying to store a string in a numeric data type. It is strongly recommended that you set Option Strict On as the default for all projects.
Option Infer On lets the compiler figure out what data type you want when you use something like Dim k = 1.0, so you don't have to type Dim k As Double = 1.0, but note that if you used Dim k = 1 it would infer k to be an Integer.
Once the data is in instances of a class in a list, you can use LINQ to process it in a fairly easy-to-read fashion, for example you could do
Console.WriteLine("The average X value is " & (myData.Select(Function(d) d.X).Average()).ToString())
I'm working on a histogram class and in particular a binning method.
In relation hereto I have two questions:
Is it a right/appropriate algorithm seen from a logic/statistical point of view
Is the code optimal or at least decent - please tell me how to improve it
Any help is highly appreciated - thx in advance.
Here is my code so far...
Public Class Histo
Dim data() As Double
Dim bins As Integer = 0
Dim bw As Double = 0
Dim _min As Double = 0
Dim _max As Double = 0
Dim arrMax As Double = 0
Dim cht As Chart
Public shared Decimals As Integer
Public Sub New(_arr() As Double, _cht As Chart)
'One-dimensional array as data
data = _arr
'No of bins with Sturges method
bins = NoBin_ST(data)
'calculate bin width
bw = Range(data) / bins
'bin boundries for first bin
_min = Min(data)
_max = _min + bw
'max of data
arrMax = Max(data)
'chart object
cht = _cht
'no of decimals on x-axis
Decimals = Dec
End Sub
Public Function Binning() As Integer()
'Binning "algorihtm" for continuous data
'
'RETURN: one-dimensional array with n bins
'
Array.Sort(data)
Dim j As Integer = 0
Dim mn As Double = _min
Dim mx As Double = _max
Dim counter(bins-1) As Integer
For i As Integer = 0 To data.GetLength(0)-1
'check if data point is within the boundries of the current bin
If data(i) >= mn AndAlso data(i) < mx Then
'add counter in current bin
counter(j) += 1
Else
'special case: at the end at least one data point will equal max of the last bin
' and must be counted in that bin
If data(i) = arrMax Then
counter(j) += 1
Continue For
End If
'the data point has exceeded the boundries of the previous bin
' and must be counted in the next bin
'min and max is increased with the bin width
mn += bw
mx += bw
'go to next bin
j += 1
'count data point in this bin and loop again
counter(j) += 1
End If
Next
Return counter
End Function
.....
Not sure if this is any more performant, but I think it is a bit simpler.
Function CreateBins(values As IEnumerable(Of Double), numberOfBins As Integer) As IGrouping(Of Integer, Double)()
If values Is Nothing Then Throw New Exception("Values cannot be null")
If values.Distinct.Count < 2 Then Throw New Exception("Values must contain at least two ditinct elements")
If numberOfBins < 1 Then Throw New Exception("numberOfBins must be an integer > 1")
Dim min = values.Min
Dim max = values.Max
Dim binSize = (max - min) / numberOfBins
' Checking for two distinct elements should eliminate possibility of min=max and therefore binsize=0
Dim bins = values.GroupBy(Function(x) Convert.ToInt32(Math.Floor((x - min) / binSize))).ToArray
' Group counts available using the ienumerable Count function
' Dim counts = bins.Select(Function(x) x.Count)
' Or retaining the group key
' Dim counts = bins.Select(Function(x) New With {Key x.Key, x.Count})
Return bins
End Function
Each bin is now a group. The original values are retained as part of the group, allowing potential follow up analysis. Count is available using the group function Count()
I'm trying to create and application which will shuffle an string array and produce 2 totally different versions where no element will match each other
like for example the initial array is A, B, C, D, E than the shuffled array must be B, D, E, A, C.
In my case when I suffle them and try to produce an output I get shuffled array but they are completely identical to each other. It seems like the values in last array override the values of the previous ones.
I tried to protect them but I don't know how to do it. Please can anybody give me a hint about what am I doing wrong?
Dim myArray() As String = {"A", "B", "C", "D", "E"}
This is the code of the button which triggers shuffle
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
RendomOutput1(myArray)
End Sub
End Class
THis is the function that shuffles first array:
Sub RendomOutput1(ByVal x() As String)
Dim t As Integer
Dim Temp As String
For i As Integer = 0 To x.Count - 1
Dim rnd As New Random
t = rnd.Next(0, x.Count - 1)
Temp = x(t)
x(t) = x(i)
x(i) = Temp
Next
RandomOutput2(x)
End Sub
This is the function which produces another array and prints the result:
Sub RendomOutput2(ByRef y() As String)
Dim y1() As String = y' May be I shall lock or somehow protect y1 here?
'Lock(y1) doesn't work
Dim t As Integer
Dim Temp As String
For i As Integer = 0 To y.Count - 1
Dim rnd As New Random
t = rnd.Next(0, y.Count - 1)
Temp = y(t)
y(t) = y(i)
y(i) = Temp
Next
For i As Integer = 0 To x.Count - 1
Label1.Text &= y1(i) & " IS NOT " & y(i) & vbCrLf
Next
End Sub
IN the result arrays y1 and y are different from initial but identical to each other. Does anybody know how can I make them different. Probably lock y1 array or something. Thank you in advance
This line
Dim y1() As String = y
doesn't create a new array - it creates a reference to an existing array. So you'll have two array references (y and y1) but only one array (both references point to the same array). When you make changes to y those changes are visible through y1 because both of them refer to the same underlying array.
What you need is 2 distinct array instances where the data held be the arrays are duplicated (that is, you need 2 array references that point to 2 different arrays). Then changes made to one array will not affect the other array.
For example:
' Create new array from the input array
Dim y1() As String = new String(y.Count-1){}
For i As Integer = 0 To y.Count-1
y1(i) = y(i)
Next i
Alternatively, you can just clone the array:
Dim y1() As String = y.Clone()
Behind the scenes this results in the same thing.
Here's a simple routine for shuffling any array:
Public Sub Shuffle(Of T)(ByRef A() As T)
Dim last As Integer = A.Length - 1
Dim B(last) As T
Dim done(last) As Byte
Dim r As New Random(My.Computer.Clock.TickCount)
Dim n As Integer
For i As Integer = 0 To last
Do
n = r.Next(last + 1)
Loop Until Not done(n)
done(n) = 1
B(i) = A(n)
Next
A = B
End Sub
Note that some elements could remain at their original index by chance.