I am trying to plot a chart using vb chart. There are some X values missing, which I would like to leave as a blank in the series plot. i.e, The X values start from 0.695, 0.7, 0.705, and so on. But there might be some gaps between them (example: 0.74, 0.745, 1.71, 1.715), which I would like leave as gaps (i.e. 0.745 to 1.71).
I was able to create an array of empty points, if that helps. Below is the code for the same.
Dim interval As Double = 0.0
Dim empty(0) As Double
Dim decimalpart As Integer = 0
interval = freq1(1) - freq1(0)
If interval.ToString().IndexOf(".") = -1 Then
decimalpart = 0 'No decimal part
Else
decimalpart = interval.ToString().Substring(interval.ToString().IndexOf(".") + 1).Length 'To find the number of decimal part
End If
y = 0
For i As Integer = 0 To freq1.Length - 2 'Dont need to access the last data. It would be accessed in the previous loop
If Math.Round((freq1(i + 1) - freq1(i)), decimalpart) > interval Then
empty(y) = freq1(i) + interval
y += 1
ReDim Preserve empty(y)
While (empty(y - 1) + interval < freq1(i + 1))
empty(y) = empty(y - 1) + interval
y += 1
ReDim Preserve empty(y)
End While
End If
Next
ReDim Preserve empty(y - 1)
The above code finds the interval and see if the next value is withing the interval range. Else it would find the values incremented using the interval value. freq1() is the array containing the X-axis values. However, I am not sure on how to remove the X axis values using empty(). (Not sure, if this could be done using Chart.Series().EmptyPointStyle)
I would like to show the gap appearing in the plot of the chart series.
I am not going to pretend what the code you have presented is doing, but showing a gap in a line plot for empty points is accomplished by setting the DataPoint.IsEmpty property to True.
Here is a simple example.
Dim s As New Series
s.ChartType = SeriesChartType.FastLine
s.Color = Color.Black
s.BorderWidth = 2
' make some points
For x As Double = 0.5 To 4 Step 0.025
Dim dp As New DataPoint(x, (2.0 * x + 3))
' apply some filtering criteria to set some points to empty
If dp.XValue >= 1.2 AndAlso dp.XValue < 1.5 Then dp.IsEmpty = True
If dp.XValue >= 3.1 AndAlso dp.XValue < 3.4 Then dp.IsEmpty = True
s.Points.Add(dp)
Next
Chart1.Series.Clear()
Chart1.Legends.Clear()
Chart1.Series.Add(s)
You can read more about this topic: Using Empty Data Points in Chart Controls
Related
I'm trying to program a motorized stage in an xy array configuration in visual basic. I take the n x n array size as input from the user and I move the stages accordingly. Here I am testing a value of 3 so a 3x3 array, The problem occurs with the outer y loop. When County reaches a value of 4, larger than the 3, the loop iterates again, adding another row to my array. Why is it iterating again even though the loop condition isn't satisfied?
Countx and County are my counters and increment every time the stage is moved. Switch is to alternate between the x stage moving back and forth (in a snake pattern)
Dim countx As Integer = 1
Dim county As Integer = 1
Dim switch As Integer = 1
While county <= arraysize
If switch = 1 Then
While countx < arraysize
AxMG17Motor1.MoveJog(0, 1)
countx = countx + 1
Await Task.Delay(5000)
End While
switch = -1
county += 1
AxMG17Motor2.MoveJog(0, 1)
Await Task.Delay(5000)
End If
If switch = -1 Then
While countx > 1
AxMG17Motor1.MoveJog(0, 2)
countx = countx - 1
Await Task.Delay(5000)
End While
switch = 1
county += 1
AxMG17Motor2.MoveJog(0, 1)
Await Task.Delay(5000)
End If
End While
Personally, I prefer absolute moves if possible. You can iterate over the indices and create locations.
I believe you can also be more accurate in allowing the motors to both complete their moves, rather than a "blind" 5 second wait. I am not sure about the thread safety of AxMG17MotorLib moving multiple stages asynchronously, but it's worth a try.
Dim rows = 3
Dim cols = 3
Dim jogSizeX = 5
Dim jogSizeY = 10
Dim originX As Single
Dim originY As Single
AxMG17Motor1.GetPosition(0, originX)
AxMG17Motor2.GetPosition(0, originY)
Dim locations = Enumerable.Range(0, rows - 1).
Select(Function(r) If(r Mod 2 = 0, Enumerable.Range(0, cols - 1).Select(Function(c) New PointF(r, c)),
Enumerable.Range(cols - 1, 0).Select(Function(c) New PointF(r, c)))).
SelectMany(Function(p) p)
For Each location In locations
Dim absoluteX = location.X * jogSizeX + originX
Dim absoluteY = location.Y * jogSizeY + originY
AxMG17Motor1.SetAbsMovePos(0, absoluteX)
AxMG17Motor2.SetAbsMovePos(0, absoluteY)
Await Task.WhenAll({Task.Run(Sub() AxMG17Motor1.MoveAbsolute(0, True)),
Task.Run(Sub() AxMG17Motor2.MoveAbsolute(0, True))})
Console.WriteLine($"Moved to absolute location: ({absoluteX}, {absoluteY}), relative index: ({location.X}, {location.Y})")
Next
i am a bit new to this but I'm trying to create a randomly generated 3d coordinate points with equal spacing, I've tried using for each loop but im confused on how to use in. the purpose is to generate sphere around that point but some sphere are overlapping each other. thanks in advance. the code below is to show how I'm generating the sphere
For i = 0 To noofsp - 1
x = Rnd(1) * maxDist
ws1.Cells(i + 5, 2) = x
y = Rnd(1) * maxDist
ws1.Cells(i + 5, 3) = y
z = Rnd(1) * maxDist
ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
You'll need to check the new point against all the other points to make sure that your new point is at a greater distance that the sum of the radii of your new sphere and each sphere you're checking against
You'll need to use pythagoras' theorem to check that the distances and I found the code below from this site. The code on the site is written in c#, but here is the vb.net version.
Public Function Distance3D(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double) As Double
' __________________________________
'd = √ (x2-x1)^2 + (y2-y1)^2 + (z2-z1)^2
'
'Our end result
Dim result As Double
'Take x2-x1, then square it
Dim part1 As Double = Math.Pow((x2 - x1), 2)
'Take y2-y1, then square it
Dim part2 As Double = Math.Pow((y2 - y1), 2)
'Take z2-z1, then square it
Dim part3 As Double = Math.Pow((z2 - z1), 2)
'Add both of the parts together
Dim underRadical As Double = part1 + part2 + part3
'Get the square root of the parts
result = Math.Sqrt(underRadical)
'Return our result
Return result
End Function
To generate the spheres, you would need to expand your code to include checking the new point against all the previously generated points. That code is below with comments.
I have assumed the definition of a variable called minDistance to specify how far apart the centre of the spheres should be. I'm also assuming that all the spheres are the same size. The number should be twice the radius of the spheres
Private Sub GenerateSpheres()
Randomize
For i As Integer = 0 To noofsp - 1
Dim distanceOK As Boolean = False
Dim x, y, z As Integer
'keep generating points until one is found that is
'far enough away. When it is, add it to your data
While distanceOK = False
x = Rnd(1) * maxDist
y = Rnd(1) * maxDist
z = Rnd(1) * maxDist
'If no other points have been generated yet, don't bother
'checking your new point
If centers.Count = 0 Then
distanceOK = True
Else
'If other points exist, loop through the list and check distance
For j As Integer = 0 To centers.Count - 1
'if the point is too close to any other, stop checking,
'exit the For Loop and the While Loop will generate a new
'coordinate for checking, and so on
Dim dist As Integer = Distance3D(centers(j)(0), centers(j)(1), centers(j)(2), x, y, z)
If dist <= minDistance Then
distanceOK = False
'exit the For loop and start the next iteration of the While Loop
Continue While
End If
Next
'If all previous points have been checked none are too close
'flag distanceOK as true
distanceOK = True
End If
End While
'ws1.Cells(i + 5, 2) = x
'ws1.Cells(i + 5, 3) = y
'ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
End Sub
I am working a code, and I have a problem with Excel's XIRR function.
You have a matrix with 2 columns (dates and amounts), so the inputs are the matrix, a date, and a quantity. Inside the code it takes the values below the date you used as input, makes a new array with those values, and add also the date and amount you entered as inputs. And the output should be the XIRR of that array. It doesn´t seem to work. It works with IRR, with dates are an important input. Does someone know how to fix this problem? Thanks in advance!
Function Retorno(matriz As Range, dia As Date, valuacion As Double) As Double
Dim Datos As Range
Dim Aux1()
Dim Aux2()
Dim i, j, m, n As Integer
Set Datos = matriz
j = 0
For i = 1 To Datos.Rows.Count
If Datos(i, 1) <= dia Then
j = j + 1
End If
Next i
ReDim Aux1(1 To j + 1)
ReDim Aux2(1 To j + 1)
For n = 1 To j + 1
Aux1(n) = Datos(n, 2)
Next n
Aux1(j + 1) = valuacion
For m = 1 To j + 1
Aux2(m) = Datos(m, 1)
Next m
Aux2(j + 1) = dia
Retorno = WorksheetFunction.Xirr(Aux1, Aux2)
End Function
Your last Aux2(j + 1) = dia is overwriting the second date in the array with the first date, giving you two identical dates in the date array.
Possibly you want to delete that line.
The other possible answer to this problem is to convert the date to numbers if you do this: Aux2(m) = Datos(m, 1)*1 XIRR will work too.
I am banging my head against the wall for a while now trying different techniques.
None of them are working well.
I have two strings.
I need to compare them and get an exact percentage of match,
ie. "four score and seven years ago" TO "for scor and sevn yeres ago"
Well, I first started by comparing every word to every word, tracking every hit, and percentage = count \ numOfWords. Nope, didn't take into account misspelled words.
("four" <> "for" even though it is close)
Then I started by trying to compare every char in each char, incrementing the string char if not a match (to count for misspellings). But, I would get false hits because the first string could have every char in the second but not in the exact order of the second. ("stuff avail" <> "stu vail" (but it would come back as such, low percentage, but a hit. 9 \ 11 = 81%))
SO, I then tried comparing PAIRS of chars in each string. If string1[i] = string2[k] AND string1[i+1] = string2[k+1], increment the count, and increment the "k" when it doesn't match (to track mispellings. "for" and "four" should come back with a 75% hit.) That doesn't seem to work either. It is getting closer, but even with an exact match it is only returns 94%. And then it really gets screwed up when something is really misspelled. (Code at the bottom)
Any ideas or directions to go?
Code
count = 0
j = 0
k = 0
While j < strTempName.Length - 2 And k < strTempFile.Length - 2
' To ignore non letters or digits '
If Not strTempName(j).IsLetter(strTempName(j)) Then
j += 1
End If
' To ignore non letters or digits '
If Not strTempFile(k).IsLetter(strTempFile(k)) Then
k += 1
End If
' compare pair of chars '
While (strTempName(j) <> strTempFile(k) And _
strTempName(j + 1) <> strTempFile(k + 1) And _
k < strTempFile.Length - 2)
k += 1
End While
count += 1
j += 1
k += 1
End While
perc = count / (strTempName.Length - 1)
Edit: I have been doing some research and I think I initially found the code from here and translated it to vbnet years ago. It uses the Levenshtein string matching algorithm.
Here is the code I use for that, hope it helps:
Sub Main()
Dim string1 As String = "four score and seven years ago"
Dim string2 As String = "for scor and sevn yeres ago"
Dim similarity As Single =
GetSimilarity(string1, string2)
' RESULT : 0.8
End Sub
Public Function GetSimilarity(string1 As String, string2 As String) As Single
Dim dis As Single = ComputeDistance(string1, string2)
Dim maxLen As Single = string1.Length
If maxLen < string2.Length Then
maxLen = string2.Length
End If
If maxLen = 0.0F Then
Return 1.0F
Else
Return 1.0F - dis / maxLen
End If
End Function
Private Function ComputeDistance(s As String, t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim distance As Integer(,) = New Integer(n, m) {}
' matrix
Dim cost As Integer = 0
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
'init1
Dim i As Integer = 0
While i <= n
distance(i, 0) = System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
End While
'find min distance
For i = 1 To n
For j = 1 To m
cost = (If(t.Substring(j - 1, 1) = s.Substring(i - 1, 1), 0, 1))
distance(i, j) = Math.Min(distance(i - 1, j) + 1, Math.Min(distance(i, j - 1) + 1, distance(i - 1, j - 1) + cost))
Next
Next
Return distance(n, m)
End Function
Did not work for me unless one (or both) of following are done:
1) use option compare statement "Option Compare Text" before any Import declarations and before Class definition (i.e. the very, very first line)
2) convert both strings to lowercase using .tolower
Xavier's code must be correct to:
While i <= n
distance(i, 0) = System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
End While
I want to plot a graph in Vb.net. I have x and y values , x indicates cycles. After every 4 cycles i want to average out all 4 cycles' value and draw a line then in the 5th cycle's graph shows its real graph value and then when cycles reach the 8th cycle then once again average out the value from the starting and plot a straight line. How can I plot this graph?
Private _averageValue As Double
Public ReadOnly Property AverageValue() As Double
Get
Return _averageValue
End Get
End Property
Private Sub CalculateAverageValue()
Try
Dim sum As Double = 0
Dim cnt As Integer = 1
_Reading = ""
'loop to find the average
If _SeparatedValues.Count > 0 Then
For cnt = 1 To _SeparatedValues.Count
sum = sum + _SeparatedValues(cnt - 1)
_Reading = _Reading & " " & _SeparatedValues(cnt - 1)
Next
_Reading = _Reading.Trim
_averageValue = sum / (cnt - 1)
Else
_averageValue = 0
End If
Catch ex As Exception
End Try
End Sub