I am currently trying to produce a sound using a custom beep class. One of the methods of the beep class is to produce multiple octaves of a sound with a given frequency, so one sound is the frequency, another is the frequency * 2, another is the frequency * 4, etc.
I am attempting to use threading to make these all sound together by giving each sound its own thread. However, I notice that it still plays sounds once-at-a-time. I can confirm that the sounds are not interrupting the flow of the program itself, however, so the threading is working in that capacity.
Here is the code I am using. The idea is that for NumOctave times, a new frequency is generated based off the first (and amplitude), and is set to sound in its own thread. However, it appears that the threads are queuing, rather than truly executing asynchronously from each other. What would be the best way to get the intended behavior?
Shared Sub OctBeep(ByVal Amplitude As Integer,
ByVal Frequency As Integer, ByVal NumOctaves As Integer,
ByVal Duration As Integer, ByVal NewThread As Boolean)
Dim threads As List(Of Thread) = New List(Of Thread)
Dim powTwo As Integer = 1
Dim powTen As Integer = 1
For oct As Integer = 1 To NumOctaves
Dim thisOct As Integer = oct
Dim thisThread As New Thread(
Sub()
Dim newFreq, newAmp As Integer
newFreq = Frequency * powTwo
newAmp = Amplitude / powTen
BeepHelp(newAmp, newFreq, Duration)
End Sub
)
thisThread.IsBackground = True
thisThread.Start()
powTwo *= 2
powTen *= 10
Next
End Sub
Here is BeepHelp()
Shared Sub BeepHelp(ByVal Amplitude As Integer,
ByVal Frequency As Integer,
ByVal Duration As Integer)
Dim A As Double = ((Amplitude * 2 ^ 15) / 1000) - 1
Dim DeltaFT As Double = 2 * Math.PI * Frequency / 44100
Dim Samples As Integer = 441 * Duration \ 10
Dim Bytes As Integer = Samples * 4
Dim Hdr() As Integer = {&H46464952, 36 + Bytes, &H45564157,
&H20746D66, 16, &H20001, 44100,
176400, &H100004, &H61746164, Bytes}
Using MS As New MemoryStream(44 + Bytes)
Using BW As New BinaryWriter(MS)
For I As Integer = 0 To Hdr.Length - 1
BW.Write(Hdr(I))
Next
For T As Integer = 0 To Samples - 1
Dim Sample As Short = CShort(A * Math.Sin(DeltaFT * T))
BW.Write(Sample)
BW.Write(Sample)
Next
BW.Flush()
MS.Seek(0, SeekOrigin.Begin)
Using SP As New SoundPlayer(MS)
SP.PlaySync()
End Using
End Using
End Using
End Sub
End Class
I ran into this same issue before writing a speech synthesizer class. There is a difference between Multi-threading(Just moves to a different thread so main program still works) & Parallel Processing(Moves the process to its own processor). You want to look into Parallel Processing instead
Related
I am using a BackgroundWorker to write to pixels on an internal bitmap, using a loop.
The BackgroundWorker DoWork routine does not access any GUI components.
If I run the loop without any Progress Reporting, the loop takes about 2 seconds to complete, which is satisfactory.
If I add Progress Reporting, the loop takes about 20 seconds to complete!! Not good!!
I notice that when Progress Reporting is on and the loop is running, the form cannot be dragged about the screen, and my Cancel button (code for this not included here) is not responded to until the loop completes.
Its as if the program was not running in a BackGroundWorker.
The Progress Reporting code is quite standard, and has been used a number of times before:
Dim x As Integer = 5000
Dim y As Integer = 2500
Dim i as Integer = 0
For a As Integer = 0 To x
For b As Integer = 0 To y
' Other fast code
worker.ReportProgress(CInt(100 * (i / (x * y)))
i += 1
Next
Next
Private Sub BGW_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BGW.ProgressChanged
ProgressBar.Value = e.ProgressPercentage
StatusLabel.Text = "Progress: " & e.ProgressPercentage & "%"
End Sub
This all seems good and standard, until I realised that the ReportProgress line is actually sending its value to the ProgressChanged routine 12,500,000 times, when actually we only need to send a value 100 times. It was the flood of values that caused the problem.
This code works perfectly. I hope it is useful to someone else:
Dim x As Integer = 5000
Dim y As Integer = 2500
Dim i as Integer = 0
Dim j As Double = (x * y) / 100
Dim k As Integer = 0
For a As Integer = 0 To x
For b As Integer = 0 To y
' Other fast code
i += 1
If i > j Then
k += 1
worker.ReportProgress(CInt(k))
i = 0
End If
Next
Next
You should use a public variable (Like "ReportValue") and a timer .
The timer is in a continuos loop and it set the value of the progressBar using the "ReportValue" .
On the other side , your backgroundWorker reports the progress in the "ReportValue" variable .
So you can refresh your ProgressBar without losing time in handling the [Progress state change]
then add this code to the timer:
If Not ReportValue = MyProgressBar.Value Then
MyProgressBar.Value = ReportValue
end if
The timer will refresh the progressbar value only if the value is changed
( preventing an high CPU usage )
Hope it helps :)
An easy way is to only report progress if there is progress to report:
Dim x As Integer = 5000
Dim y As Integer = 2500
Dim i as Integer = 0
Dim oldProgress = 0
For a As Integer = 0 To x
For b As Integer = 0 To y
' Other fast code
Dim progress = CInt(100 * (i / (x * y))
If progress > oldProgress Then
worker.ReportProgress(progress)
oldProgress = progress
End If
i += 1
Next
Next
i need to generate a square wave sound in windows . I'm using this code :
System.console.beep(500,500)
But it don't works very well : It takes a bit to play the sound .
I have a 2.7 GHZ CPU , so i don't think my computer is slow .
Does someone know a library or another code to play frequencies in windows ?
Imports:
Imports System.IO
Imports System.Media
Call:
FrequencyBeep(500, 500, 10000)
Sub:
Public Shared Sub FrequencyBeep(ByVal Amplitude As Integer, ByVal Frequency As Integer, ByVal Duration As Integer)
Dim A As Double = ((Amplitude * (System.Math.Pow(2, 15))) / 1000) - 1
Dim DeltaFT As Double = 2 * Math.PI * Frequency / 44100.0
Dim Samples As Integer = 441 * Duration / 10
Dim Bytes As Integer = Samples * 4
Dim Hdr As Integer() = {1179011410, 36 + Bytes, 1163280727, 544501094, 16, 131073, 44100, 176400, 1048580, 1635017060, Bytes}
Using MS As MemoryStream = New MemoryStream(44 + Bytes)
Using BW As BinaryWriter = New BinaryWriter(MS)
For I As Integer = 0 To Hdr.Length - 1
BW.Write(Hdr(I))
Next
For T As Integer = 0 To Samples - 1
Dim Sample As Short = System.Convert.ToInt16(A * Math.Sin(DeltaFT * T))
BW.Write(Sample)
BW.Write(Sample)
Next
BW.Flush()
MS.Seek(0, SeekOrigin.Begin)
Using SP As SoundPlayer = New SoundPlayer(MS)
SP.PlaySync()
End Using
End Using
End Using
End Sub
I have to work with multiple big 2-dimensional arrays (1024 x 128 for example) and in a section of my code I need to transpose some (up to 12 of them).
The procedure takes a fair amount of time and I'm trying to speed it up as much as possible. Knowing that VB.NET supports multi-threading I gave a read here and there to different sources and could come up with the following code in the main subroutine:
RunXTransposingThreads(Arr1, Arr2, Arr3, ...)
Using BackgroundWorkers as a part of my solution:
Private Sub RunXTransposingThreads(ParamArray ArraysToTranspose() As Array)
Dim x = CInt(ArraysToTranspose.GetLength(0)) - 1
Dim i As Integer
For i = 0 To x
Dim worker As New System.ComponentModel.BackgroundWorker
AddHandler worker.DoWork, AddressOf RunOneThread
AddHandler worker.RunWorkerCompleted, AddressOf HandleThreadCompletion
worker.RunWorkerAsync(ArraysToTranspose(i))
Next
End Sub
Private Sub RunOneThread(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim Transposed(,) As Single = Array.CreateInstance(GetType(Single), 0, 0) ' I need this to be like that in order to use other functions later
Transposed = Transpose2dArray(CType(e.Argument, Single(,)))
e.Result = Transposed
End Sub
Private Sub HandleThreadCompletion(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs)
Debug.Print("Process complete")
End Sub
Function Transpose2dArray(Of Array)(ByVal inArray As Array(,)) As Array(,)
Dim x = CInt(inArray.GetLength(1))
Dim y = CInt(inArray.GetLength(0))
Dim outArray(x - 1, y - 1) As Array
For i = 0 To x - 1
For j = 0 To y - 1
outArray(i, j) = inArray(j, i)
Next
Next
Transpose2dArray = outArray
End Function
The threads seem to work, because at some point after the execution of RunXTransposingThreads, I see on my screen a number of "Process complete". The question is: how do I stop the code in main from being executed if I don't have yet transposed arrays?
As others have said, BackgroundWorker is obsolete. Fortunately there are many other modern ways of doing this.
Therefore I won't show you something that makes your code works with BackgroundWorker. Instead I'll show you how to do the same thing by using Tasks, one of those modern ways. Hope it helps.
Function RunXTransposingTasks(ParamArray ArraysToTranspose() As Array) As Array
Dim taskList = New List(Of Task(Of Single(,))) ' our tasks returns Arrays
For Each arr In ArraysToTranspose
Dim r = arr
taskList.Add(Task.Run(Function() Transpose2dArray(r)))
Next
Task.WhenAll(taskList) ' wait for all tasks to complete.
Return taskList.Select(Function(t) t.Result).ToArray()
End Function
Function Transpose2dArray(inArray As Array) As Single(,)
Dim x = inArray.GetLength(1) - 1
Dim y = inArray.GetLength(0) - 1
Dim outArray(x, y) As Single
For i = 0 To x
For j = 0 To y
outArray(i, j) = inArray(j, i)
Next
Next
Return outArray
End Function
' Usage
' Dim result = RunXTransposingTasks(Arr1, Arr2, Arr3, ...)
You could try using build-in function to copy data
Array.Copy(inArray, outArray, CInt(inArray.GetLength(1)) * CInt(inArray.GetLength(0)))
There's also some great example on how to use Parallel.ForEach.
Is it possible to use multiple threads program to speed up the process of my program?
my program is the following
1- generate a random number
2- query by this number one remote server
3- store the result in text file
the problem is basically when i query the remote server it takes 10 seconds
instead of waiting this time I wanted to generate 100 or 1000 number and send them separately and then when the result come I will keep them in buffer and save them later to text
any help or idea in that ?
I would look at using Microsoft's Reactive Framework (NuGet Rx-Main).
This would be your code:
Dim rnd = New Random()
Dim query = _
From i In Observable.Range(0, 1000) _
From n In Observable.Start(Function () rnd.Next()) _
From r in Observable.Start(Function (x) CallWebService(x)) _
Select r
File.WriteAllLines(filePath, _
String.Join(Environment.NewLine, query.ToEnumerable()))
All run on background threads with maximum throughput.
Done!
Module Module1
Sub main()
Randomize()
Dim r = New Random
Dim rLock = New Object
Dim results As New Concurrent.ConcurrentBag(Of Tuple(Of Integer, String))
Dim getRandom = New Func(Of Integer)(Function()
SyncLock rLock
Return r.Next(0, Integer.MaxValue)
End SyncLock
End Function)
' total number of loops
' v
System.Threading.Tasks.Parallel.For(0, 100, Sub(i)
Dim aRandom = getRandom()
'process the query
Dim output = "-server-response-" 'or whatever the outcome of processing
results.Add(New Tuple(Of Integer, String)(aRandom, output))
End Sub)
For Each itm In results
Console.WriteLine(itm.Item1 & vbTab & itm.Item2)
Next
End Sub
End Module
I have exhausted all of my options and am very desperate for help since I cannot figure out where the bug in my code is, or if there is something I don't understand.
I'm trying to create a "methinks it is a weasel!" mimmick from Richard Dawkins' late 80s documentary about evolution. The goal is to progress through a genetic algorithm until the algorithm guesses the correct answer through mutation and fitness tournaments.
Now, here's the problem:
Private Function fitnessTourney(ByVal editGuess() As Guess, ByVal popIndex As Integer, ByVal tourneySize As Integer, ByVal popNum As Integer)
Dim randInt(tourneySize - 1) As Integer
Dim loopCount1 As Integer = 0
Dim fitnessWinner As New Guess
fitnessWinner.setFitness(-50)
...
And, this loop is where I am experiencing the critical error
...
For i = 0 To tourneySize - 1
Randomize()
randInt(i) = Int(Rnd() * popNum)
While editGuess(randInt(i)).Used = True
If loopCount1 > tourneySize Then
loopCount1 = 0
For i2 = 0 To popNum - 1
editGuess(i2).setUsed(False)
Next
i = -1
Continue For
End If
loopCount1 += 1
randInt(i) = Int(Rnd() * popNum)
End While
editGuess(randInt(i)).determineFitness(correctPhrase)
editGuess(randInt(i)).setUsed(True)
Next
For i = 0 To popNum - 1
editGuess(i).setUsed(False)
Next
What this loop is trying to do is pick out four random instances of the editGuess array of objects. This loop tries to prevent one from being used multiple times, as the population is competing to one of the 10 members (highest fitness of the 4 chosen candidates is supposed to win).
The critical error is that I mysteriously get an endless loop where any instances of editGuess(randInt(i)).Used will always evaluate to true. I have tried to fix this by resetting all instances to False if it loops too many times.
The stumper is that I'll have all instances evaluate to False in the debugger. Then, when I reach "editGuess(randInt(i)).setUsed(True)" (the exact same thing as "editGuess(randInt(i)).Used = True"), it sets this value for EVERY member of the array.
Is there anyone who can see what is happening? I am so close to completing this!
Here's the Guess class:
Public Class Guess
Dim Fitness As Integer
Dim strLength As Integer
Dim strArray(30) As String
Dim guessStr As String
Dim Used As Boolean
Public Sub New()
Fitness = 0
guessStr = ""
strLength = 0
Used = 0
End Sub
Public Sub determineFitness(ByVal correctPhrase As String)
Dim lowerVal
If guessStr.Length <= correctPhrase.Length Then
lowerVal = guessStr.Length
Else
lowerVal = correctPhrase.Length
End If
strArray = guessStr.Split("")
Fitness = 0 - Math.Abs(correctPhrase.Length - guessStr.Length)
For i = 0 To lowerVal - 1
If correctPhrase(i) = guessStr(i) Then
Fitness = Fitness + 1
End If
Next
End Sub
Public Sub Mutate(ByVal mutatepercentage As Decimal, ByVal goodLetters As String)
If mutatepercentage > 100 Then
mutatepercentage = 100
End If
If mutatepercentage < 0 Then
mutatepercentage = 0
End If
mutatepercentage = mutatepercentage / 100
If Rnd() < mutatepercentage Then
strLength = Int(Rnd() * 25) + 5
If strLength < guessStr.Length Then
guessStr = guessStr.Remove(strLength - 1)
End If
End If
For i = 0 To strLength - 1
If Rnd() < mutatepercentage Then
If i < guessStr.Length Then
guessStr = guessStr.Remove(i, 1).Insert(i, goodLetters(Int(Rnd() * goodLetters.Length)))
Else
guessStr = guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
End If
End If
Next
End Sub
Public Sub setFitness(ByVal num As Integer)
Fitness = num
End Sub
Public Sub setStrLength(ByVal num As Integer)
strLength = num
End Sub
Public Sub initializeText()
End Sub
Public Sub setUsed(ByVal bVal As Boolean)
Used = bVal
End Sub
End Class
And, finally, here's where and how the function is called
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
population1(counter) = fitnessTourney(population1, counter, 4, 10)
population2(counter) = fitnessTourney(population2, counter, 4, 10)
population1(counter).Mutate(2, goodLetters)
population2(counter).Mutate(20, goodLetters)
Label1.Text = population1(counter).guessStr
Label2.Text = population2(counter).guessStr
counter += 1
If counter > 9 Then
counter = 0
End If
End Sub
End Class
EDIT 1:
Thank you guys for your comments.
Here is the custom constructor I use to the form. This is used to populate the population arrays that are passed to the fitnessTourney function with editGuess.
Public Sub New()
InitializeComponent()
Randomize()
For i = 0 To 9
population1(i) = New Guess
population2(i) = New Guess
Next
counter = 0
correctPhrase = "Methinks it is a weasel!"
goodLetters = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ !##$%^&*()_+-=?></.,;\|`'~"
goodLettersArr = goodLetters.Split("")
For i = 0 To 9
population1(i).setStrLength(Int(Rnd() * 25) + 5)
population2(i).setStrLength(Int(Rnd() * 25) + 5)
For i2 = 0 To population1(i).strLength
population1(i).guessStr = population1(i).guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
Next
For i2 = 0 To population2(i).strLength
population2(i).guessStr = population2(i).guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
Next
Label1.Text = population1(i).guessStr
Label2.Text = population2(i).guessStr
Next
population1(0).guessStr = correctPhrase
population1(0).determineFitness(correctPhrase)
End Sub
I haven't studied all of your code thoroughly, but one big problem is that you are calling Randomize from within the loop. Every time you call Randomize, it re-seeds the random numbers with the current time. Therefore, if you call it multiple times before the clock changes, you will keep getting the first "random" number in the sequence using that time which will always evaluate to the same number. When generating "random" numbers, you want to re-seed your random number generator as few times as possible. Preferably, you'd only seed it once when the application starts.
As a side note, you shouldn't be using the old VB6 style Randomize and Rnd methods. Those are only provided in VB.NET for backwards compatibility. You should instead be using the Random class. It's easier to use too. With the Random class, you don't even need to call a randomize-like method, since it automatically seeds itself at the point in time when you instantiate the object. So, in the case of the Random class, the thing to be careful is to make sure that you only instantiate the object once before entering any loop where you might be using it. If you create a new Random object inside a loop, it will similarly keep generating the same numbers.