Cross Correlation in .NET - vb.net

I am working on an app that takes two audio channels and compares them to find the phase difference (delay). I came across this post;
Calculating FFT Correlation Coefficient
which refers to this sample code;
https://dotnetfiddle.net/1nWIgQ
I got the code working with correct results after translating it to VB.NET (its the language I started with years ago in this app).
The problem I see is that when I change the signal generated from random noise to a sine wave, then the code gives crazy unrelated results. Any suggestions would be appreciated.
Code below;
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports AForge.Math 'NuGet Package Aforge.Math module
Imports System.Runtime.InteropServices
Imports System.IO
Public Class Form2
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim c = New Xcorr4_2()
Dim size As Integer = 2048
Dim delay As Double
delay = 2
Dim signal1 = c.GenerateSignal(size)
Dim signal2 = c.GenerateSignal(size, delay)
Dim signal1Complex = c.ToComplexWithPadding(signal1, 2)
Dim fftSignal1 = c.FFT(signal1Complex)
Dim signal2Complex = c.ToComplexWithPadding(signal2, 2)
Dim fftSignal2 = c.FFT(signal2Complex)
Dim cc = c.CorrelationCoefficient(fftSignal1.ToArray(), fftSignal2.ToArray())
MsgBox(cc.Item1) 'correlation coeff
MsgBox(cc.Item2) 'recovered delay
End Sub
End Class
Class Xcorr4_2
Public Function CrossCorrelation(ByVal ffta As Complex(), ByVal fftb As Complex()) As Complex()
Dim conj = ffta.[Select](Function(i) New Complex(i.Re, -i.Im)).ToArray()
conj = conj.Zip(fftb, Function(v1, v2) Complex.Multiply(v1, v2)).ToArray()
FourierTransform.FFT(conj, FourierTransform.Direction.Backward)
Dim rr As Double() = New Double(conj.Length - 1) {}
rr = conj.[Select](Function(i) i.Magnitude).ToArray()
Return conj
End Function
Public Function CorrelationCoefficient(ByVal ffta As Complex(), ByVal fftb As Complex()) As Tuple(Of Double, Integer)
Dim tuble As Tuple(Of Double, Integer)
Dim correlation = CrossCorrelation(ffta, fftb)
Dim seq = correlation.[Select](Function(i) i.Magnitude)
Dim maxCoeff = seq.Max()
Dim maxIndex As Integer = seq.ToList().IndexOf(maxCoeff)
tuble = New Tuple(Of Double, Integer)(maxCoeff, maxIndex)
Return tuble
End Function
Public Function FFT(ByVal signal As Complex()) As Complex()
FourierTransform.FFT(signal, FourierTransform.Direction.Forward)
Return signal
End Function
Public Function IFFT(ByVal signal As Complex()) As Complex()
FourierTransform.FFT(signal, FourierTransform.Direction.Backward)
Return signal
End Function
Public Function ToComplexWithPadding(ByVal sample As Double(), ByVal Optional padding As Integer = 1) As Complex()
Dim logLength As Double = Math.Ceiling(Math.Log(sample.Length * padding, 2.0))
Dim paddedLength As Integer = CInt(Math.Pow(2.0, Math.Min(Math.Max(1.0, logLength), 14.0)))
Dim complex As Complex() = New Complex(paddedLength - 1) {}
Dim samples = sample.ToArray()
Dim i As Integer = 0
While i < sample.Length
complex(i) = New Complex(samples(i), 0)
i += 1
End While
While i < paddedLength
complex(i) = New Complex(0, 0)
i += 1
End While
Return complex
End Function
Public Function GenerateSignal(ByVal size As Integer, ByVal Optional shift As Integer = 0) As Double()
Dim list As List(Of Double) = New List(Of Double)()
Dim generator = New AForge.Math.Random.StandardGenerator()
' Changed original random signal to Sine wave below
For i As Integer = 0 To size - 1
'Dim randomNumber As Double = generator.[Next]()
'list.Add(randomNumber)
list.Add(Math.Sin(2 * Math.PI / 200 * i + shift))
Next
Dim list2 As List(Of Double) = New List(Of Double)()
For i As Integer = 0 To shift - 1
list2.Add(0)
Next
Dim ar = list.ToArray()
For i As Integer = 0 To size - shift - 1
list2.Add(ar(i))
Next
Return list2.ToArray()
End Function
End Class
Below is the output for original code vs the modified code with sine wave.
Original code random signal
Modified with sine wave inputs

Related

WinAPI CredEnumerate Marshal.PtrToStructure Exception

I have problems with enumerating Windows Credentials from VB.Net application with WinAPI functions. My code is below.
<DllImport("advapi32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Private Shared Function CredEnumerate(filter As String, flag As Integer, ByRef count As Integer, ByRef pCredentials As IntPtr) As Boolean
End Function
Public Enum CRED_PERSIST As UInteger
SESSION = 1
LOCAL_MACHINE = 2
ENTERPRISE = 3
End Enum
Public Enum CRED_TYPE As UInteger
GENERIC = 1
DOMAIN_PASSWORD = 2
DOMAIN_CERTIFICATE = 3
DOMAIN_VISIBLE_PASSWORD = 4
GENERIC_CERTIFICATE = 5
DOMAIN_EXTENDED = 6
MAXIMUM = 7
' Maximum supported cred type
MAXIMUM_EX = (MAXIMUM + 1000)
' Allow new applications to run on old OSes
End Enum
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Public Structure CREDENTIAL_ATTRIBUTE
Private Keyword As String
Private Flags As UInteger
Private ValueSize As UInteger
Private Value As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Private Class Credential
Public Flags As UInt32
Public Type As CRED_TYPE
Public TargetName As String
Public Comment As String
Public LastWritten As ComTypes.FILETIME
Public CredentialBlobSize As UInt32
Public CredentialBlob As IntPtr
Public Persist As CRED_PERSIST
Public AttributeCount As UInt32
Public Attributes As IntPtr
Public TargetAlias As String
Public UserName As String
End Class
Private Function GetCredentials() As Credential()
Dim count As Integer = 0
Dim pCredentials As IntPtr = IntPtr.Zero
Dim credentials As List(Of Credential) = New List(Of Credential)
Dim ret As Boolean = CredEnumerate(Nothing, 0, count, pCredentials)
If ret <> False Then
Dim p As IntPtr = pCredentials
For n As Integer = 0 To count - 1
If Marshal.SizeOf(p) = 4 Then
p = New IntPtr(p.ToInt32() + n)
Else
p = New IntPtr(p.ToInt64() + n)
End If
credentials.Add(Marshal.PtrToStructure(Marshal.ReadIntPtr(p), GetType(Credential)))
Next
End If
Return credentials.ToArray
End Function
Marshal.PtrToStructure function throws System.ExecetionEngineException without any useful information. I suspected with wrong credential structure but it seems correct to me. If you have any idea about what is wrong, I'm waiting your answers.
Thanks
Edit: Thanks to #Zaggler here is my corrected function now it adds credentials to array but whole structure is empty.
Here is new function.
Private Function GetCredentials() As Credential()
Dim count As Integer = 0
Dim pCredentials As IntPtr = IntPtr.Zero
Dim credentials As List(Of Credential) = New List(Of Credential)
Dim ret As Boolean = CredEnumerate(Nothing, 0, count, pCredentials)
If ret <> False Then
Dim p As IntPtr = pCredentials
For n As Integer = 0 To count - 1
Dim cred As Credential = New Credential
Dim pnt As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(cred))
Try
If Marshal.SizeOf(p) = 4 Then
p = New IntPtr(p.ToInt32() + n)
Else
p = New IntPtr(p.ToInt64() + n)
End If
Marshal.StructureToPtr(cred, pnt, False)
credentials.Add(Marshal.PtrToStructure(pnt, GetType(Credential)))
Finally
Marshal.FreeHGlobal(pnt)
End Try
Next
End If
Return credentials.ToArray
End Function
Your first attempt was better. Don't use AllocHGlobal and FreeHGlobal. Winapi is allocating memory. Lookup CredFree to release allocated memory (after marshalling structs).
There is a mistake in your pointer arithmetic. You have to increment with pointer size so try:
...
Dim p As IntPtr = pCredentials
For n As Integer = 0 To count - 1
credentials.Add(Marshal.PtrToStructure(Marshal.ReadIntPtr(p), GetType(Credential)))
p = p + IntPtr.Size
Next
...
UInt32 and UInteger are the same, so be consistent and choose one.
You could try to use Charset.Auto for everything, if that doesn't work, try Charset.Unicode and use CredEnumerateW function.

Lempel-Ziv-Welch algorithm

Heys guys,
I'm trying to implement the Lempel-Ziv-Welch algorithm on byte level in VB.NET. Here is what the Code looks like so far:
Dim FileBytes As Byte() = {Convert.ToByte(12), Convert.ToByte(13), Convert.ToByte(12), Convert.ToByte(13), Convert.ToByte(12), Convert.ToByte(13)}
Dim bw As New BitWriter(New BinaryWriter(New FileStream(output, FileMode.Create)))
Dim ByteDictionary As New Dictionary(Of Byte(), Integer)
Dim DictionaryN As Integer = 1
Dim DictionaryMax As Integer = 4048
Dim outputs As New List(Of Integer)
Dim bts As New List(Of Byte)
For index As Integer = 0 To FileBytes.Length - 1
Dim currentbyte As Byte = FileBytes(index)
If ContainsByte(ByteDictionary, AddToList(bts, currentbyte).ToArray) Then
bts.Add(currentbyte)
Else
If bts.Count > 1 Then
ByteDictionary.Add(bts.ToArray, 255 + DictionaryN)
DictionaryN += 1
Else
ByteDictionary.Add(New Byte() {currentbyte}, currentbyte)
End If
Console.WriteLine(GetByteValue(ByteDictionary, bts.ToArray))
bts.Clear()
bts.Add(currentbyte)
End If
Next
End Sub
Public Function ContainsByte(ByVal dic As Dictionary(Of Byte(), Integer), ByVal bt As Byte()) As Boolean
Dim flag = True
For Each kp As KeyValuePair(Of Byte(), Integer) In dic
If ByteArrayEquals(kp.Key, bt) Then
Return True
End If
Next
Return False
End Function
Public Function AddToList(ByVal list As List(Of Byte), ByVal bt As Byte) As List(Of Byte)
Dim newlist = New List(Of Byte)(list)
newlist.Add(bt)
Return newlist
End Function
Public Function ByteArrayEquals(ByVal first As Byte(), ByVal second As Byte()) As Boolean
If first.Length = second.Length Then
Dim flag = True
For index As Integer = 0 To first.Length - 1
If first(index) <> second(index) Then
flag = False
End If
Next
Return flag
Else
Return False
End If
End Function
Public Function GetByteValue(ByVal dic As Dictionary(Of Byte(), Integer), ByVal bt As Byte()) As Integer
For Each kp As KeyValuePair(Of Byte(), Integer) In dic
If ByteArrayEquals(kp.Key, bt) Then
Return kp.Value
End If
Next
End Function
The idea behind my implementation is from https://www.cs.cf.ac.uk/Dave/Multimedia/node214.html . But somehow it doesn't work, it simply puts out the input bytes. What is wrong with it?
The main problem is these two lines:
If bts.Count > 1 Then
ByteDictionary.Add(bts.ToArray, 255 + DictionaryN)
In both lines here you're using bts where you should be using bts + currentByte, i.e. you want something like
Dim currentbyte As Byte = FileBytes(index)
Dim btsPlusCurrentByte As List(Of Byte) = AddToList(bts, currentbyte)
If ContainsByte(ByteDictionary, btsPlusCurrentByte.ToArray) Then
bts.Add(currentbyte)
Else
If btsPlusCurrentByte.Count > 1 Then
ByteDictionary.Add(btsPlusCurrentByte.ToArray, 255 + DictionaryN)
The other problem is that you'll complete the loop with data left in bts that you haven't output, so I think you'll need a block to do that afterwards. It may be safe to just do
Console.WriteLine(GetByteValue(ByteDictionary, bts.ToArray))
again after the Next but I haven't thought about that very carefully.
I also think you should be able to use .NET's own built-ins rather than your four helper functions.

VB.NET - Randomize() with a function call in a string.replace method

I have a chat system and i want to put a "random string generator".
In my chat i have to write "%random%" and it is replaces with a random string.
I have a problem though, if i type "%random%%random%%random%" for example, it will generate the same string 3 times.
• Here is my function:
Public Function getRandomString(ByVal len As Integer) As String
Randomize()
Dim stringMap as string = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
Dim rnd As New Random()
For i As Integer = 0 To len - 1
Randomize()
rndString &= stringMap.Substring(rnd.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
• And here is my function call:
Dim msg As String = "Random string: %random%%random%%random%"
msg = msg.Replace("%random%", getRandomString(8))
MsgBox(msg)
The output for example: Random string: 5z15if725z15if725z15if72
I guess this is because it keeps the 1st return value in memory and pastes it, how can i fix that ?
Do i have to make a string.replace function myself ? Thanks
Oh no! You shouldn't call Randomize() here at all! Random is used in combination with the Rnd() function of VB. Creating a new Random object is enough here.
The reason you are getting the same results every time is because you are creating a new Random every time. You should reuse the same object to get different results.
'Create the object once
Private Shared rnd As New Random()
Public Function getRandomString(ByVal len As Integer) As String
Dim stringMap as string = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
For i As Integer = 0 To len - 1
rndString &= stringMap.Substring(rnd.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
EDIT: I realize that in addition to the above changes, you need to call the getRandomString function for every "%random%". String.Replace only calls the function once and pastes the result everywhere. With Regex, you could do something like this:
msg = new Regex("%random%").Replace(input, Function (match) getRandomString(8))
An easy way to do it is to find the first occurrence of "%random%", replace that, then repeat as necessary.
Written as a console application:
Option Infer On
Module Module1
Dim rand As New Random
Public Function getRandomString(ByVal len As Integer) As String
Dim stringMap As String = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
For i As Integer = 0 To len - 1
rndString &= stringMap.Substring(rand.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
Function ReplaceRandoms(s As String) As String
Dim stringToReplace = "%random%"
Dim r = s.IndexOf(stringToReplace)
While r >= 0
s = s.Remove(r, stringToReplace.Length).Insert(r, getRandomString(stringToReplace.Length))
r = s.IndexOf(stringToReplace)
End While
Return s
End Function
Sub Main()
Dim msg As String = "Random string: %random%%random%%random%"
msg = ReplaceRandoms(msg)
Console.WriteLine(msg)
Console.ReadLine()
End Sub
End Module

Merge two Array Properties in Class

I have a Class (TestClass) with the following three properties:
Private myArr1() As String
Private myArr2() As String
Private myFinalArray() As String
Private Sub Class_Initialize()
ReDim myArr1(0 To 3)
ReDim myArr2(0 To 2)
ReDim myFinalArray(0 To 6)
End Sub
Public Property Get arr1(ByVal index As Long) As Double
arr1 = myArr1(index)
End Property
Public Property Let arr1(ByVal index As Long, ByVal myvalue As Double)
myArr1(index) = myvalue
End Property
Public Property Get arr2(ByVal index As Long) As Double
...
Public Property Let arr2(ByVal index As Long, ByVal myvalue As Double)
...
Public Property Get FinalArray(ByVal index As Long) As Double
...
Public Property Let FinalArray(ByVal index As Long, ByVal myvalue As Double)
...
Here we have just two arrays that I fill with data:
Sub test()
Dim t As TestClass
Set t = New TestClass
For i = 0 To 3
t.arr1(i) = i
Next
For i = 0 To 2
t.arr2(i) = i
Next
t.GetFinalValues (t)
End Sub
My Problem now is that these array elements must be rearranged according to a confused pattern I want to write a property for that but it is not working. My idea was to add the following function to my class:
Public Function GetFinalValues(ByRef t As TestClass) As Double()
'Imput parameter arrX can ben the Value as well as the Bench arrays.
Dim arr1(2) As Double
Dim arr2(3) As Double
Dim i As Integer
Dim arrCollection(6) As Double
arrCollection(0) = t.arr1(0)
arrCollection(1) = t.arr2(0)
arrCollection(2) = t.arr2(1)
arrCollection(3) = t.arr1(1)
arrCollection(4) = t.arr2(2)
arrCollection(6) = t.arr1(2)
arrCollection(5) = t.arr2(3)
'Assign return object
For i = 0 To 6
FinalArray(i) = arrCollection(i)
Next i
GetFinalValues
End Function
If I run this the code stops at t.GetFinalValues(t) giving me the Errormessage: Object doesent support property or method. Anyone who can help me get this working? Or has a rebuild idea for a even better solution to that problem?
EDIT: I added vb.net since this might be a construction problem that is not specified to vba
You have two issues:
First you should remove the parentheses from this line:
t.GetFinalValues (t)
so it's just:
t.GetFinalValues t
Then your function needs to return a String array not Double, since that's the type of the private variable. Your class code becomes something like this:
Private Sub Class_Initialize()
ReDim myArr1(0 To 3)
ReDim myArr2(0 To 2)
ReDim myFinalArray(0 To 6)
End Sub
Public Property Get arr1(ByVal index As Long) As Double
arr1 = myArr1(index)
End Property
Public Property Let arr1(ByVal index As Long, ByVal myvalue As Double)
myArr1(index) = myvalue
End Property
Public Property Get arr2(ByVal index As Long) As Double
arr2 = myArr1(index)
End Property
Public Property Let arr2(ByVal index As Long, ByVal myvalue As Double)
myArr2(index) = myvalue
End Property
Public Property Get FinalArray(ByVal index As Long) As Double
FinalArray = myArr1(index)
End Property
Public Property Let FinalArray(ByVal index As Long, ByVal myvalue As Double)
myFinalArray(index) = myvalue
End Property
Public Function GetFinalValues(ByRef t As TestClass) As String()
'Imput parameter arrX can ben the Value as well as the Bench arrays.
Dim arr1(2) As Double
Dim arr2(3) As Double
Dim i As Integer
Dim arrCollection(6) As Double
arrCollection(0) = t.arr1(0)
arrCollection(1) = t.arr2(0)
arrCollection(2) = t.arr2(1)
arrCollection(3) = t.arr1(1)
arrCollection(4) = t.arr2(2)
arrCollection(6) = t.arr1(2)
arrCollection(5) = t.arr1(3)
'Assign return object
For i = 0 To 6
FinalArray(i) = arrCollection(i)
Next i
GetFinalValues = myFinalArray
End Function
Note that you were also trying to use t.arr2(3) which exceeds the number of elements in arr2 so I assumed you meant t.arr1(3)

What's the proper use of WaitOne() function

I was experimented some Thread pool examples. I've started from Fibonacci example on MSDN web site, but this wasn't suitable for more than 64 calculations, so i've resolved with this code:
Imports System.Threading
Module Module1
Public Class Fibonacci
Private _n As Integer
Private _fibOfN
Private _doneEvent As ManualResetEvent
Public ReadOnly Property N() As Integer
Get
Return _n
End Get
End Property
Public ReadOnly Property FibOfN() As Integer
Get
Return _fibOfN
End Get
End Property
Sub New(ByVal n As Integer, ByVal doneEvent As ManualResetEvent)
_n = n
_doneEvent = doneEvent
End Sub
' Wrapper method for use with the thread pool.
Public Sub ThreadPoolCallBackMar(ByVal threadContext As Object)
Dim threadIndex As Integer = CType(threadContext, Integer)
Console.WriteLine("thread {0} started...", threadIndex)
_fibOfN = Calculate(_n)
Console.WriteLine("thread {0} result calculated...", threadIndex)
_doneEvent.Set()
End Sub
Public Function Calculate(ByVal n As Integer) As Integer
If n <= 1 Then
Return n
End If
Return Calculate(n - 1) + Calculate(n - 2)
End Function
End Class
<MTAThread()>
Sub Main()
Const FibonacciCalculations As Integer = 65
' One event is used for each Fibonacci object
Dim doneEvents(FibonacciCalculations) As ManualResetEvent
Dim fibArray(FibonacciCalculations) As Fibonacci
Dim r As New Random()
' Configure and start threads using ThreadPool.
Console.WriteLine("launching {0} tasks...", FibonacciCalculations)
For i As Integer = 0 To FibonacciCalculations
doneEvents(i) = New ManualResetEvent(False)
Dim f = New Fibonacci(r.Next(20, 40), doneEvents(i))
fibArray(i) = f
ThreadPool.QueueUserWorkItem(AddressOf f.ThreadPoolCallBackMar, i)
Next
Console.WriteLine("All calculations are complete.")
For i As Integer = 0 To FibonacciCalculations
doneEvents(i).WaitOne()
Dim f As Fibonacci = fibArray(i)
Console.WriteLine("Fibonacci({0}) = {1}", f.N, f.FibOfN)
Next
Console.Read()
End Sub
End Module
The use of WaitOne() instead of WaitAll() resolve the problem but the question is: If I don't need to display the results then I don't need neither the second loop, but... without the second loop where I've to put the waitOne() function?
Your code does essentially this:
// start a bunch of threads to do calculations
Console.WriteLine("All calculations are complete."); // This is a lie!
// Wait for the threads to exit
The primary problem here is that the calculations are not complete when you make that call to Console.WriteLine. Well, they might be complete, but you don't know unless you've waited on the event to see that it's signaled.
The purpose of WaitOne is to tell you if the calculation has completed. Your code should be written like this:
For i As Integer = 0 To FibonacciCalculations
doneEvents(i) = New ManualResetEvent(False)
Dim f = New Fibonacci(r.Next(20, 40), doneEvents(i))
fibArray(i) = f
ThreadPool.QueueUserWorkItem(AddressOf f.ThreadPoolCallBackMar, i)
Next
Console.WriteLine("All calculations are started. Waiting for them to complete.")
For i As Integer = 0 To FibonacciCalculations
doneEvents(i).WaitOne()
Dim f As Fibonacci = fibArray(i)
Console.WriteLine("Fibonacci({0}) = {1}", f.N, f.FibOfN)
Next
Console.WriteLine("All calculations are complete.")
You must check the event to know that the calculation is complete.
Now, if you don't need to know if the calculation is complete, then there's no need for the WaitOne at all. And if you're not going to wait on the event, then there's no real need to have the event, is there? Although one wonders why you're going to do a calculation and then not use the result.