Datatable contain some values like 0.0,10000.00,54678.94 . am getting that values using for loop and store it in a variable in double datatype. i want to add these nos and store it in a variable.
each time variable value changed.
for loop
Dim ds5 As dataset1.pro_dtsumDataTable = TA5.GetData(TextBox1.Text, users)
If (ds5.Rows.Count > 0) Then
Dim y As Double
y = Double.Parse(ds5(0)("sum(fld_primary)").ToString())
Dim y1 As Double
y1 = 0 + y
End If
Next
first time y1=0.0
next time the value of y1 is not added to previous value.
i want the result y1=64679.34
am new to vb.net. please help to do this?
for loop
Dim ds5 As dataset1.pro_dtsumDataTable = TA5.GetData(TextBox1.Text, users)
If (ds5.Rows.Count > 0) Then
Dim y As Double
y = Double.Parse(ds5(0)("sum(fld_primary)").ToString())
Dim y1 As Double
y1 += 0 + y
End If
Next
You keep assigning y to y1. I think what you want to do is increment the value. eg
y1 += 0 + y
The += is the same as:
y1 = y1 + 0 + y
Related
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'm trying to find and remove outliers from many columns of data, but it doesn't clear the cells that contain the outliers when I run the code. I tried just printing "colLength" within the first For loop, and that did nothing either. Advice on where I went wrong or how I might be able to fix it?
Sub Outliers()
Dim calc As Worksheet
Set calc = ThisWorkbook.Sheets("Sheet2")
Dim num As Double
Dim x As Integer
Dim y As Integer
Dim colLength As Integer
'Variables for upper fence, lower fence, first quartile, third quartile, and interquartile range
Dim upper As Double
Dim lower As Double
Dim q1 As Double
Dim q3 As Double
Dim interquartRange As Double
For y = 1 To y = 49
'Find last row of the column
colLength = calc.Cells(Rows.count, y).End(xlUp).Row
'Calculate first and third quartiles
q1 = Application.WorksheetFunction.Quartile(Range(Cells(2, y), Cells(colLength, y)), 1)
q3 = Application.WorksheetFunction.Quartile(Range(Cells(2, y), Cells(colLength, y)), 3)
interquartRange = q3 - q1
'Calculate upper and lower fences
upper = q3 + (1.5 * interquartRange)
lower = q1 - (1.5 * interquartRange)
For x = 2 To x = colLength
num = calc.Cells(x, y)
'Remove outliers
If num > upper Or num < lower Then
Range(calc.Cells(x, y)).ClearContents
End If
Next x
Next y
End Sub
For y = 1 To y = 49 should be For y = 1 To 49. Similarly For x = 2 To x = colLength should be For x = 2 To colLength
Try this in a new module and you will see and understand the difference ;)
Dim Y As Long
Sub SampleA()
For Y = 1 To Y = 49
Debug.Print Y
Next Y
End Sub
Sub SampleB()
For Y = 1 To 49
Debug.Print Y
Next Y
End Sub
If I have a convex curve, and want to find the minimum point (x,y) using a for or while loop. I am thinking of something like
dim y as double
dim LastY as double = 0
for i = 0 to a large number
y=computefunction(i)
if lasty > y then exit for
next
how can I that minimum point? (x is always > 0 and integer)
Very Close
you just need to
dim y as double
dim smallestY as double = computefunction(0)
for i = 0 to aLargeNumber as integer
y=computefunction(i)
if smallestY > y then smallestY=y
next
'now that the loop has finished, smallestY should contain the lowest value of Y
If this code takes a long time to run, you could quite easily turn it into a multi-threaded loop using parallel.For - for example
dim y as Double
dim smallestY as double = computefunction(0)
Parallel.For(0, aLargeNumber, Sub(i As Integer)
y=computefunction(i)
if smallestY > y then smallestY=y
End Sub)
This would automatically create separate threads for each iteration of the loop.
For a sample function:
y = 0.01 * (x - 50) ^ 2 - 5
or properly written like this:
A minimum is mathematically obvious at x = 50 and y = -5, you can verify with google:
Below VB.NET console application, converted from python, finds a minimum at x=50.0000703584199, y=-4.9999999999505, which is correct for the specified tolerance of 0.0001:
Module Module1
Sub Main()
Dim result As Double = GoldenSectionSearch(AddressOf ComputeFunction, 0, 100)
Dim resultString As String = "x=" & result.ToString + ", y=" & ComputeFunction(result).ToString
Console.WriteLine(resultString) 'prints x=50.0000703584199, y=-4.9999999999505
End Sub
Function GoldenSectionSearch(f As Func(Of Double, Double), xStart As Double, xEnd As Double, Optional tol As Double = 0.0001) As Double
Dim gr As Double = (Math.Sqrt(5) - 1) / 2
Dim c As Double = xEnd - gr * (xEnd - xStart)
Dim d As Double = xStart + gr * (xEnd - xStart)
While Math.Abs(c - d) > tol
Dim fc As Double = f(c)
Dim fd As Double = f(d)
If fc < fd Then
xEnd = d
d = c
c = xEnd - gr * (xEnd - xStart)
Else
xStart = c
c = d
d = xStart + gr * (xEnd - xStart)
End If
End While
Return (xEnd + xStart) / 2
End Function
Function ComputeFunction(x As Double)
Return 0.01 * (x - 50) ^ 2 - 5
End Function
End Module
Side note: your initial attempt to find minimum is assuming a function is discrete, which is very unlikely in real life. What you would get with a simple for loop is a very rough estimate, and a long time to find it, as linear search is least efficient among other methods.
I tried to google the answer for this but could not find it. I am working on VB.Net. I would like to know what does the operator += mean in VB.Net ?
It means that you want to add the value to the existing value of the variable. So, for instance:
Dim x As Integer = 1
x += 2 ' x now equals 3
In other words, it would be the same as doing this:
Dim x As Integer = 1
x = x + 2 ' x now equals 3
For future reference, you can see the complete list of VB.NET operators on the MSDN.
a += b
is equivalent to
a = a + b
In other words, it adds to the current value.
It is plus equals. What it does is take the same variable, adds it with the right hand number (using the + operator), and then assigns it back to the variable. For example,
Dim a As Integer
Dim x As Integer
x = 1
a = 1
x += 2
a = a + 2
if x = a then
MsgBox("This will print!")
endif
those 2 lines compiled produce the same IL code:
x += 1
and
x = x + 1
Just makes code more efficient -
Dim x as integer = 3
x += 1
'x = 4
is the same as
x = x + 1
'x = 4
It can also be used with a (-):
x -= 1
' x = 2
Is the same as
x = x - 1
'x = 2
First off, here is what I have so far:
Option Explicit
Dim y As Variant
Dim yforx As Variant
Dim yfork As Variant
Dim ynew As Variant
Dim ymin As Variant
Dim x As Variant
Dim xmin As Variant
Dim k As Variant
Dim kmin As Variant
Dim s As Variant
Dim Z As Variant
Dim Track As Variant
Sub PracticeProgram()
'Selects the right sheet
Sheets("PracticeProgram").Select
'y = k ^ 2 * (x ^ 2 + 2 * x * k - 6) / (x + k) ^ 2
'these are the bounds we are stepping through
Track = 0
x = 1
xmin = 1
k = 1
kmin = 1
y = 100000000
yforx = 100000
yfork = 1000000000
Do
y = 100000000
For x = 0 To 1000 Step 0.1
ynew = kmin ^ 2 * (x ^ 2 + 2 * x * kmin - 6) / (x + kmin) ^ 2
'This checks the new y-value against an absurdly high y-value we know is wrong. if it is less than this y-value, we keep the x-value that corresponds with it.
If ynew < y Then
xmin = x
y = ynew
yforx = y
xmin = Application.Evaluate("=Round(" & xmin & ", 3)")
Else
End If
Next
MsgBox (yforx)
For k = 0 To 1000 Step 0.1
y = k ^ 2 * (xmin ^ 2 + 2 * xmin * k - 6) / (xmin + k) ^ 2
If ynew < y Then
kmin = k
y = ynew
yfork = y
kmin = Application.Evaluate("=Round(" & kmin & ",3)")
Else
End If
Next
MsgBox (yfork)
Loop Until (Abs(yforx - yfork) < 10)
End Sub
This program is supposed to find the values of x and k in order to minimize the value of y. This is a practice for a much more complicated program that will use this same concept. In my actual program y, k, and x will all be greater than zero no matter what, but since it was hard to think of a simple equation whose results would be in the shape of a parabola opening up, I decided to allow negative answers for this practice program.
Basically, it should bounce back and forth between the equations finding the ideal values for x and k until finally it has a minimal answer for y using ideal answers for both x and k. I'm not sure what the actual answer is, so I'm letting it stop within a range of 10. If it works, I'll make it smaller, but I don't want the program going for forever, just in case.
MY PROBLEM: I keep getting overflow errors! I'm trying to round the values for xmin and kmin to three figures after the decimal, but it doesn't seem to be helping. Am I using them wrong? Can someone help me get this program working?
You're doing a division by zero. xmin = 0, k = 0, (xmin + k) ^ 2 = 0. (I'm not sure why it isn't reporting division by zero.)
A suggestion: use the Locals pane to see the value of local variables. You can also use the Watch pane to see the value of expressions you want to monitor.